加速字符替换 VBA

如何解决加速字符替换 VBA

我有一个小代码，可以替换这样的表格中的字母（找到左边的字符串并用右边的字符串替换它）：

但是，在我拥有的工作表中进行所有替换（只有 2 个）需要花费大量时间。将近10秒。有没有办法加快这个速度？非常感谢您抽出时间！

Dim sht As Worksheet
Dim fndList As Integer
Dim rplcList As Integer
Dim tbl As ListObject
Dim myArray As Variant
Dim ReplaceCount As Long

Set sht = Sheets("Sheet1")
Application.ScreenUpdating = False

'Create variable to point to your table
Set tbl = Worksheets("Sheet1").ListObjects("StringReplace")

'Create an Array out of the Table's Data
Set TempArray = tbl.DataBodyRange
myArray = Application.Transpose(TempArray)
  
'Designate Columns for Find/Replace data
fndList = 1
rplcList = 2

'Loop through each item in Array lists
For x = LBound(myArray,1) To UBound(myArray,2)

'Loop through each worksheet in ActiveWorkbook (skip sheet with table in it)
    For Each sht In ActiveWorkbook.Worksheets
        If sht.Name <> tbl.Parent.Name Then
            sht.Cells.Replace What:=myArray(fndList,x),Replacement:=myArray(rplcList,_
            LookAt:=xlPart,SearchOrder:=xlByRows,MatchCase:=False,_
            SearchFormat:=False,ReplaceFormat:=False
            
        End If
    Next sht
Next x
Application.ScreenUpdating = True

解决方法

替换多个工作表中的字符串

代码

Option Explicit

Sub replaceOddStrings()
    
    Const WorksheetName As String = "Sheet1"
    Const TableName As String = "StringReplace"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim Data As Variant: Data = wb.Worksheets(WorksheetName) _
        .ListObjects(TableName).DataBodyRange.Value
    
    Dim ws As Worksheet
    Dim i As Long
    
    Application.ScreenUpdating = False
    For Each ws In wb.Worksheets
        If ws.Name <> WorksheetName Then
            For i = 1 To UBound(Data,1)
                ws.UsedRange.Replace Data(i,1),Data(i,2),xlPart,False,_
                    False,False
            Next i
        End If
    Next ws
    Application.ScreenUpdating = True

    MsgBox "Strings replaced.",vbInformation,"Success"
 
End Sub