4

正規表現パターンをExcelVBAの関数に渡そうとしていますが、パターンは効果がないようです。文字列がどのように見えるかを確認するためにmsgboxを挿入しましたが、問題はありません。これが私が使用しているコードです。

Sub clean_COP_names()
Dim strSheet As String
Dim strPatternOrig As String

Dim strRow As Integer
Dim strCol As Integer
Dim UpBound As Range
Dim LowBound As Range

Dim strUpBoundRow As Integer
Dim strUpBoundColumn As Integer
Dim strLowBoundRow As Integer
Dim strLowBoundColumn As Integer
Dim CompareRange As Range


Dim c As Variant
Dim d As Integer
    Dim strTest As String
    strTest = ActiveCell.Value

    strSheet = "Sheet2"

    strRow = 2
    strCol = 2
    strUpBoundRow = 0
    strUpBoundColumn = 0
    strLowBoundRow = 0
    strLowBoundColumn = 0

    '/////call ext function
    SelectColumn strSheet, strRow, strCol, strUpBoundRow, strUpBoundColumn, strLowBoundRow, strLowBoundColumn

    Set CompareRange = Worksheets(strSheet).Range _
(Cells(strUpBoundRow, strUpBoundColumn), Cells(strLowBoundRow, strLowBoundColumn))


    d = 1
    Cells(d, 6).Value = "Alumni Officer - Last,First names"
    strPatternOrig = """^([^ ]+)([ ]+)([^ ]+)([ ]+)([^ ]+)(.*)$"""
    'MsgBox (strPatternOrig)
    For Each c In CompareRange
    d = d + 1
        '/////ext function
        Cells(d, 6).Value = Reorder_Name_COP_Data_a(c.Value, strPatternOrig, "$3,$1")
    Next
End Sub


Function Reorder_Name_COP_Data_a(strData As String, strPattern As String, strReplacementPattern As String) As String

Dim RE As Object

Set RE = CreateObject("vbscript.regexp")
With RE
    .MultiLine = False
    '.Global = False
    .Global = True
    .IgnoreCase = True
    'MsgBox (strPattern)

    .Pattern = strPattern
End With

Reorder_Name_COP_Data_a = RE.Replace(strData, strReplacementPattern)

End Function

==================

補遺2012年4月26日どうもありがとう-

以下のようにエスケープされた引用符を使用すると、問題が解決しないことに気付きました。

 strPatternOrig = "^[ ]?([^\ ,()""'']+)(?:[ ](\(([^)]*?)\)))?[ ]((?:(([^\ ,()""''])[^\ ,()""'']*)[ ])([^\ ,()""'']+(?:[ ][^\ ,()""'']+)*))(?: [ ]? , [ ]?(.*?))?[ ]?(\(\s*'*\d*\s*\))[ ]?$"

二重引用符と一重引用符は、おそらく別の方法でエスケープする必要がありますか？上記は、正規表現パターンが関数に「ハードワイヤード」されている場合は機能しましたが、関数に渡されると失敗します。再度、感謝します。

4

1 に答える 1

1

単一引用符をエスケープする必要はなく、二重引用符のみをエスケープする必要があります。変数に文字列定数が割り当てられると、自由に渡すことができ、変更されません。

大きな正規表現で発生している唯一の実際の問題は、「空気」を残したために一致しないことです。
これはあなたが持っているものです： 

"^[ ]?([^\ ,()""'']+)(?:[ ](\(([^)]*?)\)))?[ ]((?:(([^\ ,()""''])[^\ ,()""'']*)[ ])([^\ ,()""'']+(?:[ ][^\ ,()""'']+)*))(?: [ ]? , [ ]?(.*?))?[ ]?(\(\s*'*\d*\s*\))[ ]?$"

これはあるべきものです： 

"^[ ]?([^\ ,()""']+)(?:[ ](\(([^)]*?)\)))?[ ]((?:(([^\ ,()""'])[^\ ,()""']*)[ ])([^\ ,()""']+(?:[ ][^\ ,()""']+)*))(?:[ ]?,[ ]?(.*?))?[ ]?(\(\s*'*\d*\s*\))[ ]?$"

これはあなたの正規表現のテストケースです（覚えていれば、複数の最後の形式にのみ一致します）： 

Dim RXE As Object
Dim RXNorm As Object

Sub RegexColumnValueComparison()
  Dim strData As String
  Dim strPat As String
  Call InitializeRXs

   ' Here, the grad part ('#) is optional
   strPat = "^[ ]?([^\ ,()""']+)(?:[ ](\(([^)]*?)\)))?[ ]((?:(([^\ ,()""'])[^\ ,()""']*)[ ])([^\ ,()""']+(?:[ ][^\ ,()""']+)*))(?:[ ]?,[ ]?(.*?))?[ ]?(?:(\(\s*'*\d*\s*\))[ ]?)?$"
   ' Here, the grad part ('#) is required
   'strPat = "^[ ]?([^\ ,()""']+)(?:[ ](\(([^)]*?)\)))?[ ]((?:(([^\ ,()""'])[^\ ,()""']*)[ ])([^\ ,()""']+(?:[ ][^\ ,()""']+)*))(?:[ ]?,[ ]?(.*?))?[ ]?(\(\s*'*\d*\s*\))[ ]?)$"

   strData = " John   Bert Smith, Jr  ('78) "
   MsgBox (RxRepl(strData, strPat, "$7 $8 , $1 $3 $6 $9"))
End Sub

Function RxRepl(sData As String, sPat As String, sRepl As String) As String
   sData = RXNorm.Replace(sData, " ")
   RXE.Pattern = sPat
     ' Can test for pass/fail ..
     'If RXE.Test(sData) Then
     '   MsgBox ("matched pattern")
     'Else
     '   MsgBox ("did NOT match pattern")
     'End If
   RxRepl = RXE.Replace(sData, sRepl)
End Function

Sub InitializeRXs()
  Set RXE = CreateObject("vbscript.regexp")
  Set RXNorm = CreateObject("vbscript.regexp")
  RXE.Global = True
  RXNorm.Global = True
  RXNorm.Pattern = "\s+"
End Sub
于 2012-05-01T21:22:49.593 に答える