Mehrfach Suchen und Ersetzen mit Statistik
7. März 2011
Mehrfaches "Suchen und Ersetzen" hat bereits in diesem Artikel viel Interesse erzeugt. Die Frage nach statistischen Informationen ließ sich aber nicht so einfach beantworten. Dazu sind einige Anpassungen am Code notwendig.
Excel bietet über den Aufruf im Menü "Suchen und Ersetzen" von sich aus bereits die Informationen, wie viele Inhalte ersetzt wurden. Leider ist es nach meiner Kenntnis nicht möglich, diese Informationen über VBA direkt zu erreichen. Die Lösung liegt in der Programmierung von zwei verschachtelten Schleifen. Die äußere Schleife durchläuft die Suchbegriffe, die innere Schleife alle Einträge des Tabellenblattes. Der Aufruf der instr-Funktion dient nur dem Erhalt der Information, ob der Suchbegriff in der Zelle vorhanden ist. In diesem Fall wird der Zähler für den jeweiligen Begriff inkrementiert.
Möchte man nicht den "Value" der Zelle ersetzen, kann alternativ auch mittels myCell.FormulaLocal beispielsweise eine Formel ersetzt werden.
-
Sub mehrfachSuchenUndErsetzenMitStatistik()
-
-
'sucht im aktiven Tabellenblatt jeweils die Eintraege aus
-
'suchArray und ersetzt mit ersetzArray
-
'03-2011
-
'E.Bimczok http://profi-excel.de
-
Dim suchArray()
-
Dim ersetzArray()
-
Dim StatistikArray() As Long
-
Dim k As Long
-
Dim myCell As Range
-
Dim Zellinhalt As String
-
Dim Ausgabe As String
-
-
suchArray = Array("a", "b", "c")
-
ersetzArray = Array("1", "2", "3")
-
-
ReDim StatistikArray(LBound(suchArray) To UBound(suchArray))
-
-
'alle Suchbegriffe durchlaufen
-
For k = LBound(suchArray) To UBound(suchArray)
-
'alle Zellen im verwendeten Bereich durchlaufen
-
For Each myCell In ActiveSheet.UsedRange
-
'Ersetzung durchfuehren
-
Zellinhalt = myCell.Value
-
If InStr(1, Zellinhalt, suchArray(k), vbTextCompare)> 0 Then
-
myCell.Value = Replace(Zellinhalt, suchArray(k), ersetzArray(k), , , vbTextCompare)
-
StatistikArray(k) = StatistikArray(k) + 1
-
End If
-
-
Next myCell
-
Next k
-
Ausgabe = "Folgende Ersetzungen wurden durchgeführt:"
-
For k = LBound(suchArray) To UBound(suchArray)
-
Ausgabe = Ausgabe & vbCr & suchArray(k) & " --> " & ersetzArray(k) & ": " & StatistikArray(k) & " Ersetzungen"
-
Next k
-
-
MsgBox Ausgabe
-
End Sub