批量修改多个 Excel 文件中的相同文本

Sub BatchModifyText()
    Dim FolderPath As String
    Dim FileName As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim FindText As String
    Dim ReplaceText As String
    
    ' Prompt the user to select a folder
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select a Folder"
        .Show
        If .SelectedItems.Count = 0 Then Exit Sub
        FolderPath = .SelectedItems(1) & "\"
    End With
    
    ' Set the text you want to find and replace
    FindText = "TextToFind"
    ReplaceText = "ReplacementText"
    
    ' Disable screen updating to speed up the process
    Application.ScreenUpdating = False
    
    ' Loop through each file in the folder
    FileName = Dir(FolderPath & "*.xlsx")
    Do While FileName <> ""
        ' Open the file
        Set wb = Workbooks.Open(FolderPath & FileName)
        
        ' Loop through each worksheet in the file
        For Each ws In wb.Worksheets
            ' Find and replace the text
            ws.Cells.Replace What:=FindText, Replacement:=ReplaceText, _
                LookAt:=xlPart, MatchCase:=False
        Next ws
        
        ' Save and close the file
        wb.Save
        wb.Close
        
        ' Move to the next file
        FileName = Dir
    Loop
    
    ' Enable screen updating again
    Application.ScreenUpdating = True
    
    MsgBox "Batch modification complete."
End Sub