摘要：我给VBA的定义：VBA是个人小型自动化处理的有效工具。利用好了，可以大大提高自己的劳动效率，而且可以提高数据处理的准确度。我推出的VBA系列教程共九套和一部VBA汉英手册，现在已经全部完成，希望大家利用、学习。

我给VBA的定义：VBA是个人小型自动化处理的有效工具。利用好了，可以大大提高自己的劳动效率，而且可以提高数据处理的准确度。我推出的VBA系列教程共九套和一部VBA汉英手册，现在已经全部完成，希望大家利用、学习。

如果您只是一般的职场VBA需求，可以打包选择7.1.3.9教程+汉英手册，第7套教程是入门，第1套教程是入门后的提高，第3套教程字典是必备的VBA之精华，第9套教程是实用的典型案例讲解。这四套教程内容掌握后足以处理一般工作中的问题，实际写代码的时候再辅助代码汉英手册，足矣！如果您想进一步提高，就需要选择高级阶段的教程了。

【分享成果，随喜正能量】172 一言之善，重于千金。善良不分大小，有时候你以为的一句话，小小的举手之劳，也可能就是别人的救赎！不要吝啬你的善良，因为你永远不知道那小小的善良能给多少人带来光明。

------我们一起“搭积木”，做游戏，就这么简单

如何写VBA代码，一直在有朋友向我询问这个问题，其实，写代码要有“搭积木”的思想：首先要有大量的资源，也就是积木的原型，什么是积木呢？就是各自能单独解决一个或几个小问题的单元，当你要解决新的问题时，就可以利用这些积木，将他们摆放在合适的位置，形成新的代码方案，这就是我推广的解决实际问题的思想。

写代码并不难，成为代码高手也不难，在这种思路的指引下，你很快也会成为高手。我会在文章中逐步地讲解这种思想，和大家分享。教给大家如何去摆放积木，如何利用积木。这些积木是《VBA代码解决方案》中的每一讲内容，朋友们也可以自己在平时多积累，多总结，让自己的积木越来越多。

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

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

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

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

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

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

步骤1 ：利用inputbox 函数进行人机对话

步骤2：利用FIND 函数进行查找

步骤3：利用CreateTextFile方法创建文本文件反馈，作为客户的需求。

思路有了，下面要准备我们的“积木”了，打开《VBA代码解决方案》第一册：找到第40讲和第7讲：打开《VBA代码解决方案》第二册： 找到第77讲或78讲

分别复制出上述第40、第7、 第77讲的代码如下：

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

Sub MyInputBox

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）

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

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

Sub MyCreText

Dim MyFile As Object

Dim myStr As String

Dim j As Integer, i As 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

End Sub

代码截图：

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

下面我们看代码的执行：数据1工作表的截图，我们要查找的是A115:

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

运行结束：

运行结果显示：

再次重申一点，做程序就如同搭积木，尽可能不要去写代码，当你要解决新的问题时，你首先要有自己的解决思路，然后，在你的积木库房中把你需要的积木块拿出来，余下的问题就是把你拿出的积木组合好，有的还会修正一下，就这么简单。

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

我20多年的VBA实践经验，全部浓缩在下面的各个教程中：

来源：VBA语言专业教育