VBA Tipp: Erweiterte Replace-Funktion

Aus DBWiki
Wechseln zu: Navigation, Suche

Anforderung

Ich möchte in einem Text (Zeichenfolge) mehrere untergeordnete Zeichenfolgen (Wörter) durch andere untergeordnete Zeichenfolgen ersetzen.

Lösung

Das geht mit folgender Funktion ReplaceE(), die in einem allgemeinen (globalen) Modul gespeichert wird.

Argumente der Funktion:

  • Ausdruck: Zeichenfolgenausdruck, der die zu ersetzenden, untergeordneten Zeichenfolgen enthält. Bei Eingabe von Null oder einem leeren String (leere Zeichenfolge) wird als Ergebnis ein leerer String zurückgegeben.
  • Suchen: Ein Array (Datenfeld), das die untergeordneten Zeichenfolgen enthält, nach denen gesucht wird.
  • Ersetzen:
  1. Ein Array (Datenfeld), das die untergeordneten Ersatzzeichenfolgen enthält. Hat Ersetzen weniger Werte als Suchen, so wird ein leerer String zum Ersetzen für den Rest der Werte verwendet.
  2. Angabe einer Ersatzzeichenfolge, durch die alle Werte von Suchen ersetzt werden sollen.
  • Compare (Optional): Numerischer Wert, der die Art des Vergleichs angibt, der beim Beurteilen von untergeordneten Zeichenketten verwendet werden soll.
    • vbBinaryCompare (0): Führt einen binären Vergleich durch.
    • vbTextCompare (1): Führt einen Textvergleich durch.
    • vbDatabaseCompare (2): Nur Microsoft Access. Führt einen Vergleich anhand der Informationen in deiner Datenbank durch.
Public Function ReplaceE(Ausdruck As Variant, _
                         Suchen As Variant, _
                         Ersetzen As Variant, _
                         Optional ByVal Compare As VbCompareMethod) As String
 
 ' Quelle: http://www.dbwiki.net/
 
 Dim temp         As String
 Dim i            As Long
 Dim strSuchen    As String
 Dim strErsetzen  As String
 
 If Trim(Nz(Ausdruck)) = vbNullString Then
   Exit Function
 End If
 
 temp = Ausdruck
 
 If IsArray(Suchen) Then
 
   For i = 0 To UBound(Suchen)
 
     strSuchen = Nz(Suchen(i))
 
     If IsArray(Ersetzen) Then
 
       If i > UBound(Ersetzen) Then
         strErsetzen = vbNullString
       Else
         strErsetzen = Nz(Ersetzen(i))
       End If
 
     Else
       strErsetzen = CStr(Ersetzen)
     End If
 
     If Not strSuchen = vbNullString Then
       temp = Replace(temp, strSuchen, strErsetzen, , , Compare)
     End If
 
   Next i
 
 End If
 
 ReplaceE = temp
 
End Function

Aufruf

 Dim strText As String
 Dim gesund() As Variant
 Dim lecker() As Variant
 
 strText = "Sie sollten täglich Früchte, Gemüse und Ballaststoffe essen."
 gesund = Array("Früchte", "Gemüse", "Ballaststoffe")
 lecker = Array("Pizza", "Bier", "Eiscreme")
 lecker = Array("Pizza", "Bier")
 
 ' Beispiel 1:
 ' Suchbegriffe im Array "gesund", Ersatzbegriffe im Array "lecker"
 MsgBox ReplaceE(strText, gesund, lecker)
 ' ergibt: Sie sollten täglich Pizza, Bier und Eiscreme essen.
 
 ' Beispiel 2:
 ' Suchbegriffe im Array "gesund", aber nur ein Ersatzbegriff: "nix"
 MsgBox ReplaceE(strText, gesund, "nix")
 ' ergibt: Sie sollten täglich nix, nix und nix essen.
 
 ' Beispiel 3: Reihenfolge von Ersetzungen beachten
 ' "A" wird durch "B" ersetzt, "B" wird durch "C" ersetzt, usw.
 strText = "A"
 gesund = Array("A", "B", "C", "D", "E")
 lecker = Array("B", "C", "D", "E", "F")
 MsgBox ReplaceE(strText, gesund, lecker)
 ' ergibt F

Zusatzfunktion

Mithilfe der Zusatzfunktion ArraysAusTabelleErstellen() können die zum Suchen und Ersetzen verwendeten Begriffe aus einer Tabelle, Abfrage oder SQL-Abfragetext ausgelesen, und an die Funktion ReplaceE() übergeben werden.

Argumente der Funktion:

  • Domain: Name einer Tabelle, Abfrage oder ein SQL-Abfragetext
  • Suchen: Frei lassen
  • Ersetzen: Frei lassen oder Angabe einer Ersatzzeichenfolge, durch die alle Werte von Suchen ersetzt werden sollen.
Public Function ArraysAusTabelleErstellen(Domain As String, _
                                          ByRef Suchen As Variant, _
                                          ByRef Ersetzen As Variant) As Boolean
 
 ' Quelle: http://www.dbwiki.net/
 
 Dim v As Variant
 Dim i As Long
 
 On Error Resume Next
 
 'Ergebis-Arrays zurücksetzen
 Erase Suchen
 Erase Ersetzen
 
 Err.Clear
 
 With CurrentProject.Connection.Execute(Domain)
 
   If .BOF And .EOF Then
     Err.Raise 13
   Else
     'Ganze Tabelle in Array einlesen
     v = .GetRows()
 
     ' Array für die Suche dimensionieren
     ReDim Suchen(UBound(v, 2))
 
     ' Erstes Tabellenfeld in Array einlesen
     For i = 0 To UBound(v, 2)
       Suchen(i) = v(0, i)
     Next
 
     If IsArray(Ersetzen) Or IsEmpty(Ersetzen) Then
 
       ' falls ein zweites Feld existiert
       If .Fields.Count > 1 Then
         ' Array für das Ersetzen dimensionieren
         ReDim Ersetzen(UBound(v, 2))
 
         ' Zweites Tabellenfeld in Array einlesen
         For i = 0 To UBound(v, 2)
           Ersetzen(i) = v(1, i)
         Next
       Else
         Err.Raise 13
       End If
 
     End If
 
   End If
 
 End With
 
 ArraysAusTabelleErstellen = Not CBool(Err.Number)
 
End Function

Aufruf

 Dim strText As String
 Dim varSuchen As Variant
 Dim varErsetzen As Variant
 
 strText = "Herr Maier, Herr Müller und Frau Schulze"
 
 ' Beispiel 1:
 ' varSuchen und varErsetzen bleiben frei
 ' Domain: Name eines SQL-Abfragetextes, der 2 Felder enthält
 Const Domain As String = _
       "SELECT Nachname, Left(Vorname, 1) & '. ' & Nachname FROM EineTabelle"
 ' oder alternativ Name einer Tabelle oder Abfrage, die 2 Felder enthält
 Const Domain As String = "EineTabelle"
 
 
 ' Beispiel 2:
 ' varSuchen bleibt frei
 ' Domain: Name einer Tabelle, Abfrage oder SQL-Abfragetext, die nur 1 Feld enthält
 Const Domain As String = "SELECT Nachname FROM EineTabelle"
 ' Alle Suchbegriffe in der Tabelle sollen durch den Begriff "Unbekannt" ersetzt werden
 varErsetzen = "Unbekannt"
 
 
 'Beispiel 1 oder Beispiel 2 ausführen:
 If ArraysAusTabelleErstellen(Domain, varSuchen, varErsetzen) Then
   MsgBox ReplaceE(strText, varSuchen, varErsetzen)
 Else
   MsgBox "Die Tabelle existiert nicht oder enthält ungültige oder unvollständige Daten."
 End If
 ' Beispiel 1 ergibt z.B. Herr F. Maier, Herr J. Müller und Frau E. Schulze
 ' Beispiel 2 ergibt z.B. Herr Unbekannt, Herr Unbekannt und Frau Unbekannt

Verwendung in einer Abfrage

Um die ReplaceE-Funktion in einem berechneten Feld in einer Abfrage verwenden zu können, muss sie über eine Hilfsfunktion ReplaceEFürAbfragefeld aufgerufen werden.

Die Funktion ReplaceEFürAbfragefeld wird zusätzlich zu den beiden anderen Funktionen in einem allgemeinen (globalen) Modul gespeichert.

Public Function ReplaceEFürAbfragefeld(Ausdruck As Variant, _
                                       Domain As String, _
                                       Optional Ersetzen As Variant) As String
 
 ' Quelle: http://www.dbwiki.net/
 
 Dim varSuchen As Variant
 Dim varErsetzen As Variant
 
 If Not IsMissing(Ersetzen) Then varErsetzen = Ersetzen
 
 If ArraysAusTabelleErstellen(Domain, varSuchen, varErsetzen) Then
   ReplaceEFürAbfragefeld = ReplaceE(Ausdruck, varSuchen, varErsetzen)
 End If
 
End Function

Verwendung in der Abfrage

Die Suchen- und Ersetzen-Begriffe befinden sich in der Tabelle EineTabelle

Ergebnis: ReplaceEFürAbfragefeld([EinTextFeld];"SELECT * FROM EineTabelle")
Ergebnis: ReplaceEFürAbfragefeld([EinTextFeld];"EineTabelle")

Die Suchen-Begriffe befinden sich in der Tabelle EineTabelle und werden durch den Begriff nix ersetzt

Ergebnis: ReplaceEFürAbfragefeld([EinTextFeld];"EineTabelle";"nix")

Weblinks