全民一起学vba提高篇第36回（我们一起34）

如何写VBA代码，一直在有朋友询问这个问题，其实，写代码要有"搭积木"的思想，有了大量的资源，也就是积木的原型，你去利用，去摆放，这时最好的方法。写代码并不难，成为代码高手也不难，在这种思路的指引下，你很快也会成为高手。我会在我的文章中会逐渐的讲解这种思想，和大家分享。教给大家如何去摆放积木，如何利用"积木"。这些"积木"是《VBA代码解决方案》中的内容，朋友们也可以自己积累。

今天就带大家利用这套教材的内容完成一个稍微复杂的程序制作，需求如下：

1．首先用户要和计算机进行对话，用户将录入一个人名的数据

2．VBA程序要根据用户的需求，在工作"数据1"的工作表中进行A列的完全匹配查找（为了减少篇幅，我设定是唯一的值）

3．找到数据后，要把数据导出到一个文本文件，反馈给用户。

上述的过程其实是很多地方大家都会看到的，或者有这类程序的影子，只不过要比上面的要求是复杂些，我这里就只讲些方法，具体的应用是千差万别的，让读者自己发挥吧。

为了实现上述的三个需求我们设计了如下的步骤：

找到第40讲和第7讲：

打开《VBA代码解决方案》第二册：

​ 找到第77讲或78讲

分别考出上述第40、第7、 第77讲的代码。

第40讲inputbox代码：（积木1）

SubMyInputBox()

Dim sInt As String

Dim r As Integer

r = Sheet1.Range("A65536").End(xlUp).Row

sInt = InputBox("请输入添加人员的姓名：")

If Len(Trim(sInt)) > 0 Then

Sheet1.Cells(r 1, 1) = sInt

Else

MsgBox "您没有输入内容!"

End If

End Sub

第7讲find代码：（积木2）

SubmyFind()

Dim StrFind As String

Dim Rng As Range

StrFind = InputBox("请输入要查找的值:")

If Trim(StrFind) <> "" Then

With Sheet1.Range("A:A")

Set Rng = .Find(What:=StrFind, _

After:=.Cells(.Cells.Count), _

LookIn:=xlValues, _

LookAt:=xlWhole, _

SearchOrder:=xlByRows, _

SearchDirection:=xlNext, _

MatchCase:=False)

If Not Rng Is Nothing Then

Application.Goto Rng, True

Else

MsgBox "没有找到该单元格!"

End If

End With

End If

End Sub

第77讲CreateTextFile方法代码：（积木3）

Sub MyCreText()

Dim MyFile As Object

Dim myStr As String

Dim j As Integer, iAs Integer

Set MyFile = CreateObject("Scripting.FileSystemObject") _

.CreateTextFile(ThisWorkbook.Path & "\" & "人员表单.txt", True)

For i = 1 To Range("A65536").End(xlUp).Row

myStr = ""

For j = 1 To Range("IV"& i).End(xlToLeft).Column

myStr = myStr & Cells(i, j) & ","

Next

myStr = Left(myStr, (Len(myStr) -1))

MyFile.WriteLine (myStr)

Next

MyFile.Close

Set MyFile = Nothing

End Sub

我们的积木就准备好了，当然这些积木读者要了然于胸啊，这样才能去快速的找到。下面我们要搭建积木了，我们注意到上述第7讲FIND函数的代码中包含了第40讲的INPUTBOX的代码，那么这就可以略去了第40讲的内容了，把积木1扔掉，用积木2和3即可，直接把积木2FIND的代码拷贝如下，同时为了看清楚，修正一下格式：

Sub myFind()

Dim StrFind As String

Dim Rng As Range

StrFind = InputBox("请输入要查找的值:")

If Trim(StrFind) <> "" Then

With Sheet1.Range("A:A")

Set Rng = .Find(What:=StrFind, _

After:=.Cells(.Cells.Count), _

LookIn:=xlValues, _

LookAt:=xlWhole, _

SearchOrder:=xlByRows, _

SearchDirection:=xlNext, _

MatchCase:=False)

If Not Rng Is Nothing Then

Application.Goto Rng, True '找到值后将执行的操作

Else

MsgBox "没有找到该单元格!"

End If

End With

End If

End Sub

上述代码中找到值后将执行的是： Application.Goto Rng, True 操作，而我们要求执行的是数据的导出操作，那么好了，就把上述Application.Goto Rng, True 操作换成代码77讲的内容就OK了。

下面为修正后的代码及其注释：

Public myhs As Integer '设置全局变量，用来传递找到了要找的人名时记录该单元格的行数

Sub myFind()

Dim StrFind As String

Dim Rng As Range

StrFind = InputBox("请输入要查找的人名:") '步骤1 利用INPUTBOX 函数进行人机对话

If Trim(StrFind) <> "" Then '要求用户录入的数据不能为空值

With Sheets("数据1").Range("A:A") '此处修正了工作表的名称

'完全匹配查找，完成步骤2 利用FIND 函数进行查找

Set Rng = .Find(What:=StrFind, _

After:=.Cells(.Cells.Count), _

LookIn:=xlValues, _

LookAt:=xlWhole, _

SearchOrder:=xlByRows, _

SearchDirection:=xlNext, _

MatchCase:=False)

If Not Rng Is Nothing Then

myhs = Rng.Row '设置传递函数，当找到了要找的人名时记录该单元格的行数

MyCreText '如果找到了用户要求的人名将进入MyCreText过程

Else

MsgBox "没有找到该人名!"

End If

End With

End If

End Sub

Sub MyCreText() '如果找到了用户要求的人名将执行步骤3 利用CreateTextFile方法创建文本文件作为客户的需求。

Dim MyFile As Object

Dim myStr As String

Dim j As Integer ', i As Integer I的变量去掉，用了Myhs

Set MyFile = CreateObject("Scripting.FileSystemObject") _

.CreateTextFile(ThisWorkbook.Path & "\" & "人员资料.txt", True) '把要输出的文件名称修正为人员资料

' For i = 1 To Range("A65536").End(xlUp).Row '此行代码去掉，因为值是唯一的

myStr = ""

For j = 1 To Range("IV" & myhs).End(xlToLeft).Column

myStr = myStr & Cells(1, j) & ":" & Cells(myhs, j) & ", " '此处修正代码加入输出数据的抬头

Next

myStr = Left(myStr, (Len(myStr) - 1))

MyFile.WriteLine (myStr)

'Next '此行代码去掉，因为值是唯一的

MyFile.Close

Set MyFile = Nothing

MsgBox ("OK") '添加程序完成的提示

End Sub

代码截图：

上述的讲解中你会发现，有了"积木"，代码只是改了改。改动的幅度很少，这样大量的节约了你的大量时间。

下面我们看代码的执行：

数据1工作表的截图，我们要查找的是A115:

运行后提示输入要查找的人名：

运行结束：

运行结果显示：

再次重申一点，做程序就如同搭积木，尽可能不要去写代码，你把必要的积木块拿来，组合好，你要做的只是组合、修正即可，就这么简单。

我的《VBA代码解决方案》中会有各式各样的独立的积木，给你分享，给你利用。当然你要弄懂每讲的内容才能运用自如，才能组合、修正代码。

,