EXCEL——VBA对文件夹下所有表格的特定单元格赋值

image

不知道大家有没有遇到过这种情况，一个文件夹下有很多Excel文件，每个文件里面一个或多个表都有一个同样的单元格，比如自己的名字啊、生日啊之类的。这个时候如果要改动这个单元格的内容我们需要一个个改动，就非常麻烦。这个时候我们可以通过VBA的方式来解决这个问题。。

image.png

• 如上图，我们这个文件夹下有两个表格，每个表格中都有几个sheet，这几个sheet中有几乎都有一个单元格内容如下：

  
  
  image.png

我们现在要把这个文件夹下所有EXCEL表里面所有sheet中的这个李明后面的内容改成17岁，应该怎么改呢？

Sub 遍历替换()
    Dim FindRng As Range
    Dim temp
    lookingname = "李明"
    Price = 22
    Application.ScreenUpdating = False
    Dim Filename, wb As Workbook, Sht As Worksheet
    Filename = Dir(ThisWorkbook.Path & "\*.xlsm")
    MsgBox ThisWorkbook.Path
    MsgBox Filename
    Do While Filename <> ""
        If Filename <> ThisWorkbook.Name Then
            fn = ThisWorkbook.Path & "\" & Filename
            Set wb = Workbooks.Open(fn)
            'Set Sht = wb.Worksheets(1)
                For Each temp In wb.Worksheets
                    Set FindRng = temp.UsedRange.Find(lookingname, lookat:=xlWhole)
                    If Not FindRng Is Nothing Then FindRng.Offset(, 1) = Price
                Next
                'Set FindRng = Sht.UsedRange.Find(lookingname, lookat:=xlWhole)
                'If Not FindRng Is Nothing Then FindRng.Offset(, 1) = Price
            wb.Close True
        End If
        Filename = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

利用这段代码，可以将同一文件夹下的其他表格（非当前执行代码的表格）中所有sheet中的“李明”后面的单元格内容替换。极大的提高了效率，尤其在文件很多的情况下。

• 下面我们来对代码进行一下讲解

Filename = Dir(ThisWorkbook.Path & "\*.xlsm")

用Dir来对当前表格下的所有xlsm进行遍历,下面这个循环便是对每个表格进行操作

Do While Filename <> ""
        If Filename <> ThisWorkbook.Name Then
            fn = ThisWorkbook.Path & "\" & Filename
            Set wb = Workbooks.Open(fn)
            'Set Sht = wb.Worksheets(1)
                For Each temp In wb.Worksheets
                    Set FindRng = temp.UsedRange.Find(lookingname, lookat:=xlWhole)
                    If Not FindRng Is Nothing Then FindRng.Offset(, 1) = Price
                Next
                'Set FindRng = Sht.UsedRange.Find(lookingname, lookat:=xlWhole)
                'If Not FindRng Is Nothing Then FindRng.Offset(, 1) = Price
            wb.Close True
        End If
        Filename = Dir
 Loop

其中

fn = ThisWorkbook.Path & "\" & Filename
            Set wb = Workbooks.Open(fn)
            'Set Sht = wb.Worksheets(1)
                For Each temp In wb.Worksheets
                    Set FindRng = temp.UsedRange.Find(lookingname, lookat:=xlWhole)
                    If Not FindRng Is Nothing Then FindRng.Offset(, 1) = Price
                Next
                'Set FindRng = Sht.UsedRange.Find(lookingname, lookat:=xlWhole)
                'If Not FindRng Is Nothing Then FindRng.Offset(, 1) = Price
            wb.Close True

这一段代码是将文件夹下每个文件都打开然后对其中的sheet进行遍历，并通过

 Set FindRng = temp.UsedRange.Find(lookingname, lookat:=xlWhole)
                    If Not FindRng Is Nothing Then FindRng.Offset(, 1) = Price

这两句代码来查找特定单元格并赋值。最后一个接一个打开又关闭workbook来达到替换所有单元格的效果。。。
最后，我们就可以看到所有的“李明”后面的单元格，都改变成了代码中指定的内容：

image.png

其他sheet也是已经更改，就不一一截图了~~

就是这样，希望能帮到大家，谢谢~~