Question

我在一个文件夹和子文件夹中都有很多xls文件。我想要一个vba，例如在每个文件中找到一个单词：橙色100并将其更改为另一个单词，例如。粉红色150 但我也想改变玫瑰94中的红色12 绿色111在黄色212 等等所以... 橙色100红色12绿色111 分别在粉红色150玫瑰94黄色212 有什么帮助吗？非常感谢。这样的东西，但在文件夹和子文件夹中的多个文件中：

 Sub Multi_FindReplace()

Dim sht As Worksheet
Dim fndList As Variant
Dim rplcList As Variant
Dim x As Long

fndList = Array("Orange 100", "Red 12", "Green 111")
rplcList = Array("Pink 150", "Rose 94", "Yellow 212")

'Loop through each item in Array lists
  For x = LBound(fndList) To UBound(fndList)
    'Loop through each worksheet in ActiveWorkbook
      For Each sht In ActiveWorkbook.Worksheets
        sht.Cells.Replace What:=fndList(x), Replacement:=rplcList(x), _
          LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
          SearchFormat:=False, ReplaceFormat:=False
      Next sht

  Next x

End Sub

Answer 1

您的代码看起来不错。您错过的是在文件夹和子文件夹中打开多个工作簿。所以这是我为你添加的代码。

我们使用递归来使用FileSystemObject迭代文件系统，因此将Microsoft Scripting Run时间的引用添加到项目/工作簿中。在Excel代码窗口菜单＆gt;＆gt;工具＆gt;＆gt;引用。

Option Explicit
Private Sub Multi_FindReplace(wb As Workbook)
    Dim sht As Worksheet
    Dim fndList As Variant
    Dim rplcList As Variant
    Dim x As Long

    fndList = Array("Orange 100", "Red 12", "Green 111")
    rplcList = Array("Pink 150", "Rose 94", "Yellow 212")

    'Loop through each item in Array lists
      For x = LBound(fndList) To UBound(fndList)
        'Loop through each worksheet in ActiveWorkbook
          For Each sht In wb.Worksheets 'changed Active workbook to the workbbok passed as argument
            sht.Cells.Replace What:=fndList(x), Replacement:=rplcList(x), _
              LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
              SearchFormat:=False, ReplaceFormat:=False
          Next sht

      Next x
End Sub
Public Sub FindReplace()
    Dim folderPath As String
    Dim FSO As New FileSystemObject
    folderPath = "C:\workbooks\" 'start folder modify to fit your case
    recurseFolderReplacing FSO.GetFolder(folderPath)
End Sub
Private Function recurseFolderReplacing(myfolder As Folder)
    Dim myfile As File, mySubFolder As Folder
    Dim wb As Workbook
    For Each myfile In myfolder.Files
        'filter to ensure we only touch excel files
        If Right(myfile.Name, 5) = ".xslx" Or Right(myfile.Name, 4) = ".xsl" Then
            Set wb = Workbooks.Open(myfile.Path, False, True)
            Multi_FindReplace wb
            wb.Close True
            Debug.Print "Processed " & myfile.Path
        End If
    Next

    'the recursive calls to subfolders
    For Each mySubFolder In myfolder.SubFolders
        recurseFolderReplacing mySubFolder
    Next
End Function

我没有测试过代码，请告诉我它是怎么回事。

Bikxs

查找并替换多个excel文件的多个值

1 个答案: