如何使用Vba修改多个Excel文件内容

最近在项目上，有小伙伴在验工计价的过程中需要对很多张计价表编号，据说多时上千张表要干这事儿，人工做是一件很头疼的事，于是建议他们用vba来解决这个问题，几秒钟就能完成令你焦头烂额的事。可能是几个人要做这个验工计价表，所以存在很多Excel文件，每个Excel文件又有多个工作表。这让我想起数年前为水泥搅拌桩编号的事，不能遗漏不能重复，虽然活简单，几千根桩编下来，累死，且不一定能保证符合要求。这些是计算机擅长干的事，所不同的是，我们要编写程序让计算机去做。要完成修改多个工作簿中的内容，可以按照如下思路来：01
获取指定文件夹将要编号的所有Excel文件放到一个文件夹下，实施统一修改。不可能将电脑里的文件全改了吧？代码如下，不是唯一的：Private Sub CommandButton1_Click()
Set fileDlg = Application.FileDialog(msoFileDialogFolderPicker)
  With fileDlg
   If .Show = -1 Then
         For Each fld In .SelectedItems
            path = fld
            Exit For
         Next fld
   End If
  End With
Label1.Caption = path
End Sub

唔，这段代码改自网上。还记得百度么？有人藐视百度，是因为他不能正确使用罢了。不是长期从事软件编写工作的谁记得住那么多命令和语句？以前咱们要翻书翻遍图书馆，现在只需要输入关键词回车就ok，这就是信息时代。

不过要能识别真伪，百度之所以谓之“度娘”，是因为搜索结果含有大量“泥沙”的缘故。

这段代码能看懂么？定义一个文件夹对话框对象，msoFileDialogFolderPicke参数允许用户选择一个文件夹。在这个问题中，只需要一个文件夹。
02
获取指定文件夹下所有Excel文件获取指定路径下所有Excel文件代码：
Function GetFiles(ByVal path) As String()
Application.ScreenUpdating = False
Set fso = CreateObject("scripting.filesystemobject")
Set ff = fso.getfolder(path)
ActiveSheet.UsedRange.ClearContents
Dim ls() As String
Dim a As Integer
ReDim ls(1 To 1)
a = 1
ReDim Preserve GetFiles(a)
For Each F In ff.files
      If F.Name = "" Then Exit For
      ext = Split(F.Name, ".")(UBound(Split(F.Name, ".")))
      If ext = "xlsx" Then
      ls(a) = F
      a = a + 1
      ReDim Preserve ls(1 To a)
      End If
Next F
Application.ScreenUpdating = True
Dim b As Integer
b = UBound(ls)
GetFiles = ls
End Function
把这个功能做成了一个函数，方便以后修改和调用。函数返回的是一个字符串数组，每个数组元素是一个Excel文件名（包括路径）。
03
在Excel中打开其他的Excel文件并修改1和2已经做好打开的准备。下面是打开工作簿的代码，也包含读取各个sheet并编号汇总：
Private Sub CommandButton2_Click()
Sheet1.UsedRange.ClearContents
If path = "" Then MsgBox "请先选择文件夹": Exit Sub'没有选文件夹则退出
Dim files() As String
files = GetFiles(path)'获取指定文件夹Excel文件名及路径信息
Dim NO As Integer'编号计数
Dim Trow As Integer'为统计表填表行号
Trow = 1
NO = 1
For i = 1 To UBound(files) - 1
   Workbooks.Open Filename:=files(i)'打开第i个Excel文件
   For j = 1 To Workbooks(Workbooks.Count).Sheets.Count'循环搜索第i个文件中的所有工作表
      Workbooks(Workbooks.Count).Activate
      Dim lssheet As Worksheet'准备操作工作表
         Set lssheet = Workbooks(Workbooks.Count).Sheets(j)
         lssheet.Activate
         Dim Rows As Integer
         Rows = ActiveSheet.UsedRange.Rows.Count
            For m = 1 To Rows
            If InStr(lssheet.Cells(m, 1).Value, "总包单位") > 0 Then'由于总包单位是编号的唯一标识行，故搜索这个条件
               lssheet.Cells(m, 1) = "总包单位：*********** 合同号：                               编号：" & TextBox1.Text & GetNO(NO)'编号并写入
               Sheet1.Cells(Trow, 1).Value = files(i)'统计被修改过的文件名
               Sheet1.Cells(Trow, 2).Value = lssheet.Name'统计被修改过的表名
               Sheet1.Cells(Trow, 3).Value = TextBox1.Text & GetNO(NO)'写入的编号
               Trow = Trow + 1
               NO = NO + 1
            End If
      Next m
   Next j
   Workbooks(Workbooks.Count).Save'保存修改后的第i个文件
   Workbooks(Workbooks.Count).Close'关闭打开的第i个文件
Next i
Ftotal = UBound(files) - 1'打开的总的文件数
Ntotal = NO - 1'总的编号
MsgBox "共编写了" & Ftotal & "个文件，" & Ntotal & "个编号"
End Sub

为什么使用Workbooks(Workbooks.Count)这样的方式？网上搜到的是Workbooks(2），这是因为Excel可以存在多个应用程序实例（即同时打开多个Excel程序），我们要修改的是哪一个？如果你刚好在使用这个程序之前打开了两个Excel程序，这样的引用显然是错误的，为防止这个情况，对网上的代码做了修改。当然这不是最完美的，最好的做法是为打开的文件定义一个workbook对象，然后引用，时间晚了偷点懒，就没有修改了，读者可以自行修改。

百度等搜索引擎，你会用了吗？
04
程序界面设计效果在vba中设计一个窗体，有点丑，好用就行：

为方便在excel中使用，在表格中设计一个按钮：

点击按钮调用窗体：

05
程序测试效果选好文件夹，并设置编号的固定部分：

点击开始编号：

测试了3个文件，42张计价表的编号。大约还是花了约5秒钟，时间主要花在打开文件和保存文件上，由于表格没有明显的搜索结束条件，搜索内容也花了一定的时间（整张表要搜完）。06
小结只要明晰了基本思路，要实现这个功能并不困难，文中代码没有用图片的方式，目的在于读者方便复制。要查询vba的函数使用，msdn是一个最好的地方；要学习一些编程的技术，csdn是一个建议去的地方。当然，你可以对这个程序进行修改，完成其他的事。识别图中二维码，关注“工程测量之家”公众号。