将正则表达式模式从子传递到 Excel VBA 中的函数 [英] Passing Regex Pattern From Sub to Function in Excel VBA

问题描述

我正在尝试将正则表达式模式传递给 Excel VBA 中的函数，但该模式似乎无效.我已插入 msgbox'es 以查看字符串的外观，结果正常.这是我正在使用的代码.

I'm trying to pass a Regex pattern to a Function in Excel VBA, but the pattern seems to be of none effect. I've inserted msgbox'es to see what the string looks like, and they turn out ok. Here's the code I'm using.

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 日非常感谢-

addendum apr 26,2012 Many thanks-

我注意到当我使用转义引号时问题仍然存在，如下所示:

I've noticed that the problem persists when I use escaped quotes as below:

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

双引号和单引号是否需要以不同的方式转义，可能吗?当 Regex 模式硬连接"到函数中时，上面的方法有效，但是当它传递给函数时，它失败了.再次感谢.

Do the double and single quotes need to be escaped in a different way, possibly? The above worked when the Regex pattern was 'hard wired' into the function, but when it's passed to the function, it fails. Thanks again.

推荐答案

你不需要转义单引号，只需要转义双引号.一旦变量被分配了一个字符串常量，它就可以自由地传递并且不会改变.

You don't need to escape single quotes, only the double quotes. Once the variable has been assigned with a string constant, it can be passed around freely and it will not change.

您在使用大正则表达式时遇到的唯一真正问题是它不匹配，因为您在其中留下了一些空气".
这就是你所拥有的:

The only real problem you are having with the big regex is that it is not matching because you left some 'air' in it.
This is what you have:

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

应该是这样的:

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

这是一个带有正则表达式的测试用例(如果我记得的话，它只匹配多尾形式):

Here is a test case with your regex (which only matches multi-last form, if I remember):

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

这篇关于将正则表达式模式从子传递到 Excel VBA 中的函数的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！