传递正则表达式从子在Excel VBA到功能 [英] Passing Regex Pattern From Sub to Function in Excel VBA
问题描述
我想传递一个正则表达式模式在Excel VBA功能,但图案似乎是没有任何效果。我已经插入msgbox'es看到字符串的样子,他们变成确定。
这里的code我使用。
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
==================
==================
补遗四月26,2012
非常感谢 -
addendum apr 26,2012 Many thanks-
我注意到,问题仍然存在,当我使用如下转义引号:
I've noticed that the problem persists when I use escaped quotes as below:
strPatternOrig = "^[ ]?([^\ ,()""'']+)(?:[ ](\(([^)]*?)\)))?[ ]((?:(([^\ ,()""''])[^\ ,()""'']*)[ ])([^\ ,()""'']+(?:[ ][^\ ,()""'']+)*))(?: [ ]? , [ ]?(.*?))?[ ]?(\(\s*'*\d*\s*\))[ ]?$"
不要双和单引号需要以不同的方式进行转义,可能是?上述工作时,正则表达式是硬连接到函数,但是当它传递给函数,它失败。
再次感谢。
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屋!