Excel - Rechercher et remplacer plusieurs mots

Mise à jour au bas de l'adressage de Michael commentaire re une meilleure approche pour beaucoup de modèle de remplacement

Si vous enregistrez une macro simple en utilisant le manuel Replace options dans le menu Excel, vous obtiendrez le code que vous pouvez ranger jusqu'à ce

1. La première option de mise à jour d'une cellule dans la ActiveSheet que contient "I am A1" à "I am System" - une partie de la chaîne de match
2. La deuxième option mettre à jour uniquement les cellules dans le ActiveSheet qui contient uniquement "A1" à "Sytem" - c'est à dire un ensemble de cellules chaîne de 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

Mise à jour

Le code ci-dessous

1. Utilise une base Timer de comparer le remplacement de tous les partielle chaînes allant de A1-A99 et B1-B99
2. Les deux méthodes sont
   • La Replace méthode ci-dessus, appelé 198 fois (c'est à dire 2*99) dans une boucle
   • Un RegExp \ tableau de variant combo

Sur mon test de la deuxième méthode est plus rapide pour les 198 remplacements sur un de 1 000 000 de cellules de gamme.

Moins de remplacements permettra d'améliorer la vitesse relative vers la Replace. De plus en plus vers le RegExp
Plus de cellules permettra également d'améliorer la vitesse relative vers la Replace. Moins vers la RegExp

Je n'ai pas procéder à essayer un Find méthode à plus tard l'analyse de chaînes de caractères. Comme un hyrbrid type de solution (trouver puis analyser ut de ne pas être compétitifs à un seul remplacer ou analyser)

Minuterie

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) Remplacer Sous

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

2) Regexp - Tableau De Variantes Sous

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

OriginalL'auteur brettdj