Regulärer Ausdruck VBA: bestimmte Daten finden

Question

Ich habe ein Problem mit meinem Makro aufgetreten. Ich versuche in einer Zeichenfolge Elemente zu finden, die mit FP 608 oder TM 608 beginnen.

Die Zeichenfolge, die ich versuche zu extrahieren, beginnt immer mit FP oder TM. Die Elemente danach sind Zahlen, 3 oder 4 Zahlen (100 oder 1000). Sie können auch 2 Dezimalstellen haben (100.10 oder 1000.10).

Zum Beispiel sollte es extrahieren:

• ABCDF FP 573,83 ABDFEG HIJ KLM 0124" : Extract: 573,83
• ABCFED ERD 536,98 [...] = keine Extraktion
• TM 123,12 ABCDD EFGHIJ KLM: Extract TM 123,12
• FP 100: Ausschnitt: FP 100

Dies scheint zu funktionieren, aber es ist ineffizient:

Function GetRealCost(MyRange As Variant) 

Application.ScreenUpdating = False 
Application.EnableEvents = False 
Application.DisplayStatusBar = False 

    Dim regEx As Object 
    Set regEx = CreateObject("vbscript.regexp") 
    Dim strPattern As String 
    Dim strInput As String 
    Dim strOutput As Object 

    strPattern = "\b(TM)([0-9]{3,4})(,[0-9]{1,2}\b)" 

    With regEx 
     .Global = True 
     .MultiLine = True 
     .IgnoreCase = False 
     .Pattern = strPattern 
    End With 

     strInput = MyRange 

     If regEx.test(strInput) Then 
      regEx.Pattern = "(\b[0-9]{3,4})(,[0-9]{1,2}\b)" 
      Set strOutput = regEx.Execute(MyRange) 
      GetRealCost = regEx.Execute(strInput)(0) 
     Else 
      strPattern = "\b(TM)([0-9]{3,4}\b)" 
      regEx.Pattern = strPattern 
       If regEx.test(strInput) Then 
        regEx.Pattern = "(\b[0-9]{3,4}\b)" 
        Set strOutput = regEx.Execute(MyRange) 
        GetRealCost = regEx.Execute(strInput)(0) 
         Else 
          strPattern = "\b(FP)([0-9]{3,4})(,[0-9]{1,2}\b)" 
          regEx.Pattern = strPattern 
           If regEx.test(strInput) Then 
           regEx.Pattern = "(\b[0-9]{3,4})(,[0-9]{1,2}\b)" 
           Set strOutput = regEx.Execute(MyRange) 
           GetRealCost = regEx.Execute(strInput)(0) 
             Else 
           strPattern = "\b(FP)([0-9]{3,4}\b)" 
           regEx.Pattern = strPattern 
            If regEx.test(strInput) Then 
             regEx.Pattern = "(\b[0-9]{3,4}\b)" 
             Set strOutput = regEx.Execute(MyRange) 
             GetRealCost = regEx.Execute(strInput)(0) 
              Else 
             GetRealCost = "" 
            End If 
        End If 
       End If 
     End If 

Application.ScreenUpdating = True 

End Function 

Vielen Dank!

Answer 1

Die Ineffektivität ist hauptsächlich auf das Anwenden und Testen vieler regulärer Ausdrücke zurückzuführen, die alle zu einem einzigen zusammengeführt werden können. Außerdem kann die Codegeschwindigkeit verbessert werden, indem das Objekt RegExp nur einmal erstellt und festgelegt wird, da das Erstellen und Festlegen für jede Zelle unter Verwendung der Formel möglicherweise unwirksam wird.

Schließlich glaube ich nicht, dass es eine gute Idee, die Bildschirmaktualisierung und andere Sachen in einem UDF, deaktivieren/aktivieren, weil das einmal für jede einzeln berechnet Zelle gelten, die kontraintuitiv ist, und es wird haben keinen Effekt, weil UDFs den Status der Anwendung nicht ändern dürfen, abgesehen von der Berechnung eines Ergebnisses.

Sie könnten diese UDF versuchen stattdessen:

Function GetRealCost(strInput As String) As String 
    Static reg As Object 
    If reg Is Nothing Then 
    Set reg = CreateObject("vbscript.RegExp") 
    reg.Global = True 
    reg.MultiLine = True 
    reg.IgnoreCase = False 
    reg.Pattern = "\b((FP)|(TM))\d{3,4}(,\d{1,2})?\b" 
    End If 

    Dim matches As Object: Set matches = reg.Execute(strInput) 
    If matches.count <> 0 Then GetRealCost = Mid(matches(0), 4) 
End Function