2012-04-25 17 views
4

Excel VBAの関数にRegexパターンを渡そうとしていますが、パターンは効果がないようです。文字列がどのように見えるかを確認するためにmsgboxを挿入しました。 ここに私が使用しているコードがあります。私は、問題が解決しないことに気付きました4月26,2012 多くExcel VBAで正規表現パターンをサブ関数から関数に渡す

thanks-

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 

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

補遺

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

二重引用符と一重引用符を異なる方法でエスケープする必要がありますか?上記の関数は、Regexパターンが関数にハード配線されているときに機能しますが、関数に渡されると失敗します。 もう一度ありがとうございます。

+2

本当に両側に余分な二重引用符が必要な場合は疑いがあります。あなたがそれらを削除するとどうなりますか? ([]] +)(。*)$ "'? '([]] +)([] +)([] +) –

+2

@Pradeep:あなたはちょうど頭の爪に当たったかもしれません!私は他の正規表現文字列でテストし、上記の関数はうまくいきました。 :) –

+1

@PradeepKumar、私も。 –

答えて

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 
関連する問題