vba Excel - 查找和替换多个单词

Excel - Find and replace multiple words

提问by user960358

I just want to do a simple find and replace for multiple strings. For example, I need to replace all "A1", "A2", "A3" with "system" and all "B1", "B2" with "ACC" and so on...

我只想做一个简单的查找和替换多个字符串。例如，我需要将所有“A1”、“A2”、“A3”替换为“系统”，将所有“B1”、“B2”替换为“ACC”等等......

Does anyone know a good route to take? I'm just not sure how to get this started. Thanks for the help!

有谁知道一条好的路线吗？我只是不确定如何开始。谢谢您的帮助！

采纳答案by brettdj

Update at bottom adressing Michael's comment re a better approach for many pattern replacements

在底部更新迈克尔的评论是许多模式替换的更好方法

If you record a simple macro using the manual Replaceoptions from the Excel menu you will get code that you can tidy up to this

如果您使用ReplaceExcel 菜单中的手动选项记录一个简单的宏，您将获得可以整理的代码

1. The first option will update a cell in the ActiveSheetthan contains "I am A1"to "I am System"- a part string match
2. The second option will only update cells in the ActiveSheetthat contains only "A1"to "Sytem"- ie a whole cell string match

1. 第一个选项将更新ActiveSheet比包含"I am A1"到"I am System"- 部分字符串匹配中的单元格
2. 第二个选项只会更新只ActiveSheet包含"A1"to 的"Sytem"单元格 - 即整个单元格字符串匹配

code

代码

Sub UpdatePartial()
With ActiveSheet.UsedRange
.Replace "A1", "System", xlPart
.Replace "A2", "System", xlPart
.Replace "A3", "System", xlPart
.Replace "B1", "ACC", xlPart
.Replace "B2", "ACC", xlPart
End With
End Sub

Sub UpdateWhole()
With ActiveSheet.UsedRange
.Replace "A1", "System", xlWhole
.Replace "A2", "System", xlWhole
.Replace "A3", "System", xlWhole
.Replace "B1", "ACC", xlWhole
.Replace "B2", "ACC", xlWhole
End With
End Sub

Update

更新

The code below

下面的代码

1. Uses a basic Timerto compare replacing all partialstrings ranging from A1-A99and B1-B99
2. The two methods are
   • The Replacemethod above called 198 times (ie 2*99) in a loop
   • A RegExp\ variant array combo

1. 使用基本Timer比较替换所有部分字符串，范围从A1-A99和B1-B99
2. 这两种方法是
   • Replace上面的方法循环调用了198次（即2*99）
   • A RegExp\ 变体数组组合

On my testing the second method is faster for the 198 replacements on a 1,000,000 cell range.

在我的测试中，对于 1,000,000 个单元格范围内的 198 个替换，第二种方法更快。

Less replacements will improve the relative speed towards the Replace. More towards the RegExpMore cells will also improve the relative speed towards the Replace. Less towards the RegExp

更少的替换将提高朝向Replace. 越往越RegExp多单元格也将提高朝 的相对速度Replace。少朝RegExp

I didn't proceed with trying a Findmethod with later parsing of strings. As a hyrbrid type solution (findthen parseut wouldn't be competetive to a single replaceor parse)

我没有继续尝试Find稍后解析字符串的方法。作为混合类型的解决方案（findthen parseut 将无法与单个替换或解析竞争）

Timer

计时器

Sub MainCaller()
Dim dbTime As Double
Dim lngCnt As Long

dbTime = Timer()
For lngCnt = 1 To 99
Call UpdatePartial("A" & lngCnt, "System")
Call UpdatePartial("B" & lngCnt, "System")
Next lngCnt
Debug.Print Timer() - dbTime
dbTime = Timer()
Call RegexReplace("(A|B)[1-99]", "System")
Debug.Print Timer() - dbTime
End Sub

1) Replace Sub

1) 更换子

Sub UpdatePartial(StrIn As String, StrOut As String)
ActiveSheet.UsedRange.Replace StrIn, StrOut, xlPart
End Sub    

2) Regexp - Variant Array Sub

2) 正则表达式 - 变体数组子

Sub RegexReplace(StrIn As String, StrOut As String)
    Dim rng1 As Range
    Dim rngArea As Range
    Dim lngRow As Long
    Dim lngCol As Long
    Dim lngCalc As Long
    Dim objReg As Object
    Dim X()


    'On Error Resume Next
    'Set rng1 = Application.InputBox("Select range for the replacement of leading zeros", "User select", Selection.Address, , , , , 8)
    'If rng1 Is Nothing Then Exit Sub
    'On Error GoTo 0

    ActiveSheet.UsedRange
    Set rng1 = ActiveSheet.UsedRange

    'See Patrick Matthews excellent article on using Regular Expressions with VBA
    Set objReg = CreateObject("vbscript.regexp")
    With objReg
    .Pattern = StrIn
    .ignorecase = False
    .Global = True
    End With

   'Speed up the code by turning off screenupdating and setting calculation to manual
   'Disable any code events that may occur when writing to cells
    With Application
        lngCalc = .Calculation
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With

    'Test each area in the user selected range

    'Non contiguous range areas are common when using SpecialCells to define specific cell types to work on
    For Each rngArea In rng1.Areas
        'The most common outcome is used for the True outcome to optimise code speed
        If rngArea.Cells.Count > 1 Then
           'If there is more than once cell then set the variant array to the dimensions of the range area
           'Using Value2 provides a useful speed improvement over Value. On my testing it was 2% on blank cells, up to 10% on non-blanks
            X = rngArea.Value2
            For lngRow = 1 To rngArea.Rows.Count
                For lngCol = 1 To rngArea.Columns.Count
                    'replace the leading zeroes
                    X(lngRow, lngCol) = objReg.Replace(X(lngRow, lngCol), StrOut)
                Next lngCol
            Next lngRow
            'Dump the updated array back over the initial range
            rngArea.Value2 = X
        Else
            'caters for a single cell range area. No variant array required
            rngArea.Value = objReg.Replace(rngArea.Value, StrOut)
        End If
    Next rngArea

    'cleanup the Application settings
    With Application
        .ScreenUpdating = True
        .Calculation = lngCalc
        .EnableEvents = True
    End With

    Set objReg = Nothing
End Sub