加快字符替换 VBA
Speed Up Characters replacement VBA
我有这个小代码可以像这样替换 table 中的字母(找到左边的字符串并将其替换为右边的字符串):
然而,我需要花费大量时间来替换我所有的表格(只有 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, x), _
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, False
Next i
End If
Next ws
Application.ScreenUpdating = True
MsgBox "Strings replaced.", vbInformation, "Success"
End Sub
我有这个小代码可以像这样替换 table 中的字母(找到左边的字符串并将其替换为右边的字符串):
然而,我需要花费大量时间来替换我所有的表格(只有 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, x), _
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, False
Next i
End If
Next ws
Application.ScreenUpdating = True
MsgBox "Strings replaced.", vbInformation, "Success"
End Sub