Excel - Suchen und ersetzen mehrere Wörter

Update unten auf Michaels Kommentar re ein besserer Ansatz für viele Muster Ersatz

Wenn Sie record ein einfaches makro mit dem manuellen Replace Optionen aus dem Excel-Menü erhalten Sie code, den Sie sauber bis zu diesem

1. Die erste option wird aktualisieren Sie auf eine Zelle in der ActiveSheet als enthält "I am A1" zu "I am System" - ein Teil-string-match
2. Die zweite option aktualisiert nur die Zellen in der ActiveSheet enthält nur "A1" zu "Sytem" - ie eine whole-cell-string-match

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

Den code unten

1. Verwendet eine basic - Timer zu vergleichen, zu ersetzen teilweise Saiten reichen von A1-A99 und B1-B99
2. Die beiden Methoden sind
   • Die Replace Methode oben genannt 198-mal (also 2*99) in einer Schleife
   • Eine RegExp \ array mit variant-combo

Meiner Prüfung die zweite Methode ist schneller, für die 198 Ersatz auf einem 1,000,000 Zellbereich.

Weniger Ersetzungen verbessern die relative Geschwindigkeit in Richtung des Replace. Mehr in Richtung der RegExp
Mehr Zellen verbessert auch die relative Geschwindigkeit in Richtung des Replace. Weniger auf RegExp

Ich nicht gehen, mit dem Versuch einer Find Methode mit später Parsen von strings. Als hyrbrid-Typ-Lösung (finden dann analysieren ut wäre nicht konkurrenzfähig zu einem einzigen ersetzen oder analysieren)

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) Ersetzen Sub

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

2) Regexp - Variante Array Sub

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

InformationsquelleAutor brettdj