Excel - Regulärer Ausdruck Ersatz mit Wörterbuch-Wert

Question

Wir versuchen automatisch bestimmte Teil einer Zeichenfolge in jeder Excel-Zelle automatisch basierend auf einem VBA-Wörterbuch zu übersetzen.

Original-String Beispiele:

1.Outer Fabric:2% EA, 44% WO, 54% PES; Lining:4% EA, 96% RY 
Outside:2% EA, 98% WO 
1.Outer Fabric:27% PA, 73% WV; 2.Lining:100% CO; 2.Outer Fabric:100% AOS 

Regulärer Ausdruck ist definiert als:

Dim strPattern As String: strPattern = "(\d{1,3}\%\s+)(\w+)" 

ich es getestet und es funktioniert gut: http://refiddle.com/im7s

Das Wörterbuch von einem anderen spreasheet Excel aufgebaut ist. Die Beispiel Schlüssel/Wert-Paare sind:

EA: Leather 
WO: Cloth 
PES: Polyester 
RY: Other 
... 

Aber ich kann nicht einen Weg finden, diese Wörterbuchschlüssel zu verwenden, um die ursprüngliche Zeichenfolge zu ersetzen. Zeile 12 unten ist, was ich getestet, aber es kann das Wörterbuch Wert nicht finden ...

Dim strPattern As String: strPattern = "(\d{1,3}\%\s+)(\w+)" 
Dim strInput As String 
Dim Myrange As Range 

Set Myrange = ActiveSheet.Range("A2:A50") 
With regex 
    .Global = True 
    .MultiLine = True 
    .IgnoreCase = False 
    .Pattern = strPattern 
End With 
Dim strReplace As String: strReplace = "$1" & IIf(Dict.Exists("$2"), Dict("$2"), "$2") 

For Each cell In Myrange 
    If strPattern <> "" Then 
     strInput = cell.Value 
     cell.Value = regex.replace(strInput, strReplace) 
    End If 
Next 

Jede Führung dieses Problem gelöst bekommen wird sehr geschätzt. Vielen Dank!

Answer 1

Ich glaube nicht, dass Sie Regex dafür brauchen. Wenn ich übersetze, benutze ich normalerweise nur Brute Force mit ersetzen.

str = Replace (str, "EA", "Leather") 
str = Replace (str, "WO", "Cloth") 
str = Replace (str, "PES", "Polyester") 

Etc.
Und sobald alle replace wurde getan, Sie wissen, dass es die Abkürzungen übersetzt hat, die excist.
Wenn WO nicht in der Zeichenfolge ist, wird die Ersetzung fehlschlagen und einfach mit der nächsten fortfahren.

Answer 2

Hier ist eine grundlegende Übersicht:

Sub Tester() 

    Dim regEx As Object, dict As Object 
    Dim matches, m 
    Dim c As Range 
    Dim s As String, mat As String 

    Set dict = CreateObject("scripting.dictionary") 
    dict.Add "EA", "Leather" 
    dict.Add "WO", "Cloth" 
    dict.Add "PES", "Polyester" 
    dict.Add "RY", "Leather" 

    Set regEx = CreateObject("vbscript.regexp") 
    regEx.Pattern = "(\d{1,3}\%\s+)(\w+)" 
    regEx.Global = True 
    regEx.IgnoreCase = True 
    regEx.MultiLine = True 

    For Each c In ActiveSheet.Range("A1:A10") 
     s = c.Value 
     Set matches = regEx.Execute(s) 
     If Not matches Is Nothing Then 
      'loop over each of the match objects 
      For Each m In matches 
       mat = m.submatches(1) '<<second submatch=material code 
       If dict.Exists(mat) Then 
        s = Replace(s, m, Replace(m, mat, dict(mat))) 
       End If 
      Next m 
     End If 
     c.Offset(0, 1).Value = s 
    Next c 

End Sub