使用vba在多个工作表和工作簿中查找excel中的值

Question

我有一个宏，可以找到值"并替换为值"b"跨多个工作表和工作簿宏循环遍历文件夹中的文件和子文件夹中的文件，并替换它能找到的所有值。

现在我希望宏返回工作表列E中的文件名，只有在文件中进行更改时(因此，如果a被b替换为返回列E中的文件名)

但是我当前的代码它只返回它运行的第一个工作簿的文件名

我的代码从sub search开始，它接受sub()作为输入

Sub FindReplaceAcrossMultipleExcelWorkbooksFreeMacro(Path As String)
Dim CurrentWorkbookName As String
Dim ExcelCounter As Integer
Dim ExcelWorkbook As Object
Dim FindReplaceCounter As Integer
Dim FindandReplaceWorkbookName As String
Dim FindandReplaceWorksheetName As String
Dim LastRow As Integer
Dim oFile As Object
Dim oFolder As Object
Dim oFSO As Object
Dim Shape As Shape
Dim ws As Worksheet
Dim myrange As Range
Dim look As String
FindandReplaceWorkbookName = ActiveWorkbook.Name
FindandReplaceWorksheetName = ActiveSheet.Name

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(Path)
For Each oFile In oFolder.Files              'Loop through every File in Active Workbook's folder path

If InStr(1, oFile.Type, "Microsoft Excel") <> 0 And InStr(1, oFile.Name, FindandReplaceWorkbookName) = 0 And InStr(1, oFile.Name, "~") = 0 Then 'If the File Type contains the phrase Microsoft Excel isn't the current Excel Workbook and is NOT Lock File
Set ExcelWorkbook = Application.Workbooks.Open(Path & "" & oFile.Name) 'Open Excel Workbook
CurrentWorkbookName = ActiveWorkbook.Name 'Name of Active Excel Workbook that was opened
Application.Workbooks(CurrentWorkbookName).Activate 'Ensure open Excel Workbook is active for future reference using ActiveWorkbook
Application.ScreenUpdating = False   'Limit screen flashing when Excel Workbooks opened and when Find & Replace is completed
FindReplaceCounter = 2
LastRow = Workbooks(FindandReplaceWorkbookName).Sheets(FindandReplaceWorksheetName).Cells(Rows.Count, 1).End(xlUp).Row 'Identify Last Row in Column A
Do Until FindReplaceCounter > LastRow 'Complete the Find and Replace for all values in Column A & B
For Each ws In ActiveWorkbook.Worksheets 'Loop through every Excel Worksheet in Active Excel Workbook
Set myrange = ws.UsedRange.Find(what:="ben")
If Not myrange Is Nothing Then

Workbooks(FindandReplaceWorkbookName).Sheets(FindandReplaceWorksheetName).Range("E" & Rows.Count).End(xlUp).Offset(1, 0) = ExcelWorkbook.Name

End If

ws.Cells.Replace what:=Workbooks(FindandReplaceWorkbookName).Sheets(FindandReplaceWorksheetName).Cells(FindReplaceCounter, 1).Value, Replacement:=Workbooks(FindandReplaceWorkbookName).Sheets(FindandReplaceWorksheetName).Cells(FindReplaceCounter, 2).Value

Next ws

FindReplaceCounter = FindReplaceCounter + 1

Loop

ActiveWorkbook.Save                  'Save Active Excel Workbook
ActiveWorkbook.Close                 'Close Active Excel Workbook
End If

Next oFile
Application.ScreenUpdating = True            'Turn Excel ScreenUpdating back on
Set ExcelWorkbook = Nothing
Set oFSO = Nothing
Set oFolder = Nothing
Set oFile = Nothing

Exit Sub

End Sub

Sub Search()
FindReplaceAcrossMultipleExcelWorkbooksFreeMacro (Cells(2, 3).Value)
MsgBox "The Find and Replace has been completed."

End Sub

Answer 1

如果我理解正确的话，也许下面的代码可以帮助您将其与您的情况进行比较。

Sub test()
Dim rg As Range: Dim wb As Workbook
Dim oFSO: Dim oFolder: Dim oFile
Dim fn As String: Dim sh As Worksheet: Dim cell As Range
Application.ScreenUpdating = False
Set wb = ActiveWorkbook
With wb.Sheets("Sheet1")
Set rg = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
.Range("E:E").ClearContents
End With
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder("D:test")
For Each oFile In oFolder.Files
fn = oFile.Name
If InStr(fn, "test") Then GoTo nextfile:
Workbooks.Open oFile
With ActiveWorkbook
For Each sh In .Worksheets
For Each cell In rg
If Not sh.Cells.Find(cell.Value) Is Nothing Then
sh.UsedRange.Replace what:=cell.Value, Replacement:=cell.Offset(0, 1).Value, LookAt:=xlWhole
wb.Sheets("Sheet1").Range("E" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
fn & " - " & sh.Name & " : value " & cell.Value & " is replaced with " & cell.Offset(0, 1).Value
End If
Next
Next
.Close SaveChanges:=False
End With
nextfile:
Next oFile
Application.ScreenUpdating = True
End Sub

要测试代码，创建3个工作簿:

1. 命名第一个wb "test.xlsm"，这是代码所在的wb。
   在测试中。xlsm表Sheet1，在列A和B中制作两列标题，并命名为:FIND在A1中，REPLACE在B1中。在FIND下，将aaa放在A2中，bbb放在A3中，ccc放在A4中。在REPLACE下，将XXX放在B2中，YYY放在B3中，ZZZ放在B4中。
2. 创建另外两个工作簿，根据自己的喜好命名。在每个wb中，将aaa和/或bbb和/或ccc放置到任何单元格或任何工作表中，随你喜欢。
3. 测试。将xlsm和其他两个工作簿放在D盘的一个文件夹中，命名该文件夹为"test"。
运行test.xlsm中的代码。确保另外两个工作簿是关闭的。

代码中有三个循环。
第一个是循环到test文件夹
中的每个文件，第二个是循环到该文件
的每个工作表，第三个是循环到工作表Sheet1 test.xlsm

中的每个FIND/REPLACE值。在第一个循环中，它打开文件/工作簿(不是test.xlsm)
，然后它循环到在循环的工作表上打开的wb
的每个工作表，它循环到sheet1 test中FIND/REPLACE下的每个数据。然后执行两个过程:(A)将找到的值替换为替换值(B)将信息写入test.xlsm

的E列sheet1中。请注意，代码不会在正在打开的循环工作簿的循环工作表上写入信息。如果找到要替换的值，则将其替换为新值。

如果第二次运行子表，则test.xlsm中的E列Sheet1中不应该有任何信息。