Передача шаблона регулярного выражения из Sub в функцию в Excel VBA

Я пытаюсь передать шаблон регулярных выражений функции в Excel VBA, но шаблон кажется неэффективным. Я вставил msgbox'es, чтобы посмотреть, как выглядит строка, и они выглядят нормально. Вот код, который я использую.Передача шаблона регулярного выражения из Sub в функцию в Excel VBA

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

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

добавление апрелю 26,2012 Многие

Благодарения и

Я заметил, что проблема не устранена когда я использую кавычки экранированы, как показано ниже:

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

ли двойные и одинарные кавычки должны быть экранированы иначе, возможно? Вышеописанное работало, когда шаблон Regex был «жестко связан» с функцией, но когда он передается функции, он терпит неудачу. Еще раз спасибо.

источник

2012-04-25 buck1112

Я сомневаюсь, что вам действительно нужны дополнительные двойные кавычки с обеих сторон. Что произойдет, если вы их удалите? т. е. 'strPatternOrig ="^([^] +) ([] +) ([^] +) ([] +) ([^] +) (. *) $ "'? –

@Pradeep: Возможно, вы просто ударили ноготь по голове! Я тестировал с помощью других строк RegEx, и вышеуказанная функция работала нормально. :) –

@PradeepKumar, я тоже. –

Вам не нужно избегать одиночных кавычек, только двойные кавычки. Как только переменная была назначена с константой строки, ее можно свободно перемещать, и она не изменится.

Единственная реальная проблема, с которой вы сталкиваетесь с большим регулярным выражением, заключается в том, что она не соответствует, потому что вы оставили в ней некоторый «воздух».
Это то, что у вас есть:

"^[ ]?([^\ ,()""'']+)(?:[ ](\(([^)]*?)\)))?[ ]((?:(([^\ ,()""''])[^\ ,()""'']*)[ ])([^\ ,()""'']+(?:[ ][^\ ,()""'']+)*))(?: [ ]? , [ ]?(.*?))?[ ]?(\(\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-01 21:22:49 sln

Передача шаблона регулярного выражения из Sub в функцию в Excel VBA

ответ

Смежные вопросы