VBA：正则表达式和Dir（）函数问题

Question

我写了一个简单的脚本，使用VBA。 （我需要用excel优化一些工作）。

关于正则表达式的第一个问题：

正如我之前所说的，我使用了VBA。

简单的任务：获取模式匹配并捕获子匹配。

我的代码是：

Dim ResStr as Object 
Dim LastStr as Object 
Dim RE as Object 


Set RE = CreateObject("vbscript.regexp") 'create a regex 
With RE 
    .MultiLine = False 'm-key 
    .Global = False  'g-key 
    .IgnoreCase = False 'i-key 
    .Pattern = "[<]TD\s+class=gm[>](\d+\.\d+)[<][/]TD[>]" 'tag 
End With 

Set ResStr = RE.Execute(StrDollar) 'use regex 
Set LastStr = ResStr(0).SubMatches 'get submatch 

如何获得最后一场比赛和最后的子匹配？ （长度属性？）

第二个问题有关Dir函数：

如何过滤的文件？

我看到这个MSDN代码：

' Display the names in C:\ that represent directories. 
    MyPath = "c:\" ' Set the path. 
    MyName = Dir(MyPath, vbDirectory) ' Retrieve the first entry. 
    Do While MyName <> "" ' Start the loop. 
    ' Use bitwise comparison to make sure MyName is a directory. 
    If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then 
     ' Display entry only if it's a directory. 
     Debug.WriteLine(MyName) 
    End If 
    MyName = Dir() ' Get next entry. 
    Loop 

If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then - 停止“MSDN-家伙！你在开玩笑吗？它只是一种方法？

是否有任何可能的方法来使正常的过滤器，而不是这种巨大的方法？

Answer 1

要获得所有比赛中，子匹配，长度等您会使用这样的事情 - 我添加了一个工作示例用一个简单的模式来演示（即匹配数字的序列，然后用一个非数字）

你应该假设在比赛前Test你的正则表达式已经发现，以避免错误回报

Sub Test() 
Dim RE As Object 
Dim strSample As String 
Dim ResStr As Object 
Dim LastStr As Object 
strSample = "123dd6789a" 
Set RE = CreateObject("vbscript.regexp") 'create a regex 
With RE 
    .MultiLine = False 'm-key 
    .Global = True  'g-key 
    .IgnoreCase = False 'i-key 
    .Pattern = "\d+([^\d])" 
End With 
If RE.Test(strSample) Then 
    Set ResStr = RE.Execute(strSample) 
    For Each LastStr In ResStr 
     MsgBox "Match: " & LastStr & vbNewLine & "SubMatch: " & LastStr.submatches(0) & vbNewLine & "Position: " & LastStr.firstindex + 1 & vbNewLine & "Length: " & LastStr.Length 
    Next 
End If 
End Sub 

Answer 2

问题1

你可以试试这个：

Sub Test(StrDollar) 
Dim LastStr As Object 
Dim RE As New RegExp 
Dim mt As Match 


With RE 
    .MultiLine = False 'm-key 
    .Global = True  'g-key 
    .IgnoreCase = False 'i-key 
    .Pattern = "<TD\s+class=gm>(\d+\.\d+)</TD>" 'tag 
    For Each mt In .Execute(StrDollar) 
     Set LastStr = mt.SubMatches 'get submatch 
    Next mt 
End With 

MsgBox LastStr(0) 

End Sub 

---

Quetion 2

也许dir()功能不能够基于的文件列表延期。

[编辑]

Sub Test2(StrDollar) 
Dim LastStr As Object 
Dim RE As New RegExp 
Dim mt As Match 
Dim dic As New Scripting.Dictionary 'scripting runtime 
Dim pos& 

With RE 
    .MultiLine = False 'm-key 
    .Global = True  'g-key 
    .IgnoreCase = False 'i-key 
    .Pattern = "<TD\s+class=gm>(\d+\.\d+)</TD>" 'tag 
    For Each mt In .Execute(StrDollar) 
     pos = pos + 1 
     dic.Add CStr(pos), mt.FirstIndex & "||" & mt.Value & "||" & mt.SubMatches(0) 
    Next mt 
End With 

MsgBox dic.item(CStr(pos)) 

End Sub 

[/编辑]