VBA-通过模式搜索在VBE模块中查找所有编号的行 [英] VBA - Find all numbered lines in VBE Modules via pattern search
问题描述
任务:
我的目标是在我的代码模块的过程中找到所有编号的行. CodeModule.Find 方法可用于检查搜索字词(目标参数).
My goal is to find all numbered lines in procedures of my Code Modules. The CodeModule.Find method can be used to check for search terms (target parameter).
语法:
对象.查找(目标，开始行，开始行，结束行，结束行[，全字] [，区分大小写[， patternsearch ]])
object.Find(target, startline, startcol, endline, endcol [, wholeword] [, matchcase] [, patternsearch])
引荐帮助站点 https://msdn.microsoft.com/zh-CN/library/aa443952(v=vs.60).aspx 指出: 参数 patternsearch :可选.一个布尔值，指定目标字符串是否为正则表达式模式. 如果为True，则目标字符串为正则表达式模式.默认为False.
The referring help site https://msdn.microsoft.com/en-us/library/aa443952(v=vs.60).aspx states: parameter patternsearch: Optional. A Boolean value specifying whether or not the target string is a regular expression pattern. If True, the target string is a regular expression pattern. False is the default.
如上所述，find方法允许进行正则表达式模式搜索，我想使用它来以精确的方式识别编号的行: 数字后跟制表符.因此，以下示例定义了一个搜索字符串s，并将.Find方法中的最后一个参数PatternSearch设置为True.
As explained above the find method allows a regex pattern search, which I would like to use in order to identify numbered lines in a precise way: digits followed by a tab. The example below therefore defines a search string s and sets the last parameter PatternSearch in the .Find method to True.
问题 AFAIK有效的正则表达式定义可能是
Problem AFAIK a valid regex definition could be
s = "[0-9]{1,4}[ \t]"
但是它什么也没显示，甚至没有错误.
but that doesn't show anything, not even an error.
为了显示至少任何结果，我定义了搜索词
In order to show at least any results, I defined the search term
s = "[0-9]*[ \t]*)"
在调用示例过程 ListNumberedLines 中显示不稳定的结果.
in the calling example procedure ListNumberedLines showing erratic results.
问题
是否有可能在CodeModule.Find方法中使用有效的正则表达式模式搜索?
Is there any possibility to use a valid regex patternsearch in the CodeModule.Find method?
示例代码
Option Explicit
' ==============
' Example Search
' ==============
Sub ListNumberedLines()
' Declare search pattern string s
Dim S As String
10 S = "[0-9]*[ \t]*)"
20 Debug.Print "Search Term: " & S
30 Call findWordInModules(S)
End Sub
Public Sub findWordInModules(ByVal sSearchTerm As String)
' Purpose: find modules ('components') with lines containing a search term
' Method: .CodeModule.Find with last parameter patternsearch set to True
' Based on https://www.devhut.net/2016/02/24/vba-find-term-in-vba-modulescode/
' VBComponent requires reference to Microsoft Visual Basic for Applications Extensibility
' or keep it as is and use Late Binding instead
' Declare module variable oComponent
Dim oComponent As Object 'VBComponent
For Each oComponent In Application.VBE.ActiveVBProject.VBComponents
If oComponent.CodeModule.Find(sSearchTerm, 1, 1, -1, -1, False, False, True) = True Then
Debug.Print "Module: " & oComponent.Name 'Name of the current module in which the term was found (at least once)
'Need to execute a recursive listing of where it is found in the module since it could be found more than once
Call listLinesinModuleWhereFound(oComponent, sSearchTerm)
End If
Next oComponent
End Sub
Sub listLinesinModuleWhereFound(ByVal oComponent As Object, ByVal sSearchTerm As String)
' Purpose: list module lines containing a search term
' Method: .CodeModule.Find with last parameter patternsearch set to True
Dim lTotalNoLines As Long 'total number of lines within the module being examined
Dim lLineNo As Long 'will return the line no where the term is found
lLineNo = 1
With oComponent ' Module
lTotalNoLines = .CodeModule.CountOfLines
Do While .CodeModule.Find(sSearchTerm, lLineNo, 1, -1, -1, False, False, True) = True
Debug.Print vbTab & "Zl. " & lLineNo & "|" & _
Trim(.CodeModule.Lines(lLineNo, 1)) 'Remove any padding spaces
lLineNo = lLineNo + 1 'Restart the search at the next line looking for the next occurence
Loop
End With
End Sub
推荐答案
关于CodeModule的结论.通过搜索模式查找
首先，CodeModule.Find无法通过搜索模式提供帮助，并且其可能的使用是不透明的. 我同意VBIDE API极其有限，并且存在我非常推荐任何程序员使用的出色专业工具:-)
Firstly, CodeModule.Find doesn't help via search pattern and its possible use is intransparent. I agree that the VBIDE API is extremely limited and that there exist excellent professional tools which I highly recommand for any programmer :-)
后果:通过XML解决问题
第二，如果可能的话，我更喜欢家庭补救措施，因此我试图仅使用VBIDE的有用部分来找到替代解决方案.
Secondly I prefer household remedies if possible, so I tried to find an alternative solution using only the helpful parts of VBIDE.
方法 这就是为什么我尝试了CodeModule.Lines的简单xml对话，从而允许在逻辑行内进行灵活的搜索. 我没有在请求xml数据中使用正则表达式，而是演示了一种通过定义明确的XPath搜索(通过节点列表循环)查找前导数字的方法， 从而解决了@ThunderFrame所示的大多数问题.函数showErls中的搜索字符串被定义为"line [substring(translate(.，'0123456789'，'¹¹¹¹¹1¹1¹1¹')，1,1)=¹"]"
Method That is why I tried a simple xml conversation of the CodeModule.Lines allowing a flexible search within logical lines. Instead of using regular expressions in requesting the xml data, I demonstrate a method to find leading numbers via a well defined XPath search (loop thru node list), thus resolving most problems shown by @ThunderFrame. The search string in function showErls is defined as "line[substring(translate(.,'0123456789','¹¹¹¹¹¹¹¹¹¹'),1,1)="¹"]"
此外，函数"lineNumber"返回模块内的逻辑行号. 注意:为简单起见，搜索仅限于一个模块(用户定义的常数MYMODULE)，并且代码避免使用任何正则表达式.
Furthermore function 'lineNumber' returns the logical line number within the module. Note: To keep it simple, the search is restrained to one module only (user defined constant MYMODULE) and code avoids any regex.
解决代码-主子问题
Option Explicit
' ==========================================
' User defined name of module to be analyzed
' ==========================================
Const MYMODULE = "modThunderFrame" ' << change to existing module name or userform
' Declare xml file as object
Dim xCMods As Object ' Late Binding; instead of Early Bd: Dim xCMods As MSXML2.DOMDocument6
Public Sub TestLineNumbers()
' =================
' A. Load/refresh code into xml
' =================
' set xml into memory - contains code module(s) lines
Set xCMods = CreateObject("MSXML2.Domdocument.6.0") ' L.Bd.; instead of E.Bd: Set xCMods = New MSXML2.DOMDocument60
xCMods.async = False
xCMods.validateOnParse = False
' read in user defined code module and load xml, if failed show error message
refreshCM MYMODULE
If xCMods Is Nothing Then Exit Sub
' ======================
' B. search line numbers
' ======================
showERLs
' =============================
' C. Save xml if needed
' =============================
' xCMods.Save ThisWorkbook.Path & "\VBE(" & MYMODULE & ").xml"
' MsgBox "Successfully exported Excel data to " & ThisWorkbook.Path & "\VBE(" & MYMODULE & ").XML!", _
' vbInformation, "Module " & MYMODULE & " to xml"
' =================
' D. terminate xml
' =================
Set xCMods = Nothing
End Sub
子过程
Private Sub showERLs()
' Purpose: [B.] declare XPath search string and define special translate character
Dim s As String
Dim S1 As String: S1 = Chr(185) ' superior number 1 (hex B9) replaces any digit
' declare node and node list
Dim line As Object
Dim lines As Object
' define XPath search string for first digit in line (usual case)
s = "line[substring(translate(.,'0123456789','" & String(10, S1) & "'),1,1)=""" & _
S1 & _
"""]"
' start debugging
Debug.Print "**search string=""" & s & """" & vbNewLine & String(50, "-")
Debug.Print "Line #|Line Content" & vbNewLine & String(50, "-"); ""
' set node list
Set lines = xCMods.DocumentElement.SelectNodes(s)
' -------------------
' loop thru node list
' -------------------
For Each line In lines
Debug.Print Format(lineNumber(line), "00000") & "|" & line.Text ' return logical line number plus line content
Next line
End Sub
Private Sub refreshCM(sModName As String)
' Purpose: [A.] load xml string via LoadXML method
Dim sErrTxt As String
Dim line As Object
Dim lines As Object
Dim xpe As Object
Dim s As String ' xpath expression
Dim pos As Integer ' position of line number prefix
' ======================================
' 1. Read code module lines and load xml
' ======================================
If Not xCMods.LoadXML(readCM(sModName)) Then
' set ParseError object
Set xpe = xCMods.parseError
With xpe
sErrTxt = sErrTxt & vbNewLine & String(20, "-") & vbNewLine & _
"Loading Error No " & .ErrorCode & " of xml file " & vbCrLf & _
Replace(" " & Replace(.URL, "file:///", "") & " ", " ", "[No file found]") & vbCrLf & vbCrLf & _
xpe.reason & vbCrLf & _
"Source Text: " & .srcText & vbCrLf & _
"char?: " & """" & Mid(.srcText, .linepos, 1) & """" & vbCrLf & vbCrLf & _
"Line no: " & .line & vbCrLf & _
"Line pos: " & .linepos & vbCrLf & _
"File pos.: " & .filepos & vbCrLf & vbCrLf
End With
MsgBox sErrTxt, vbExclamation, "XML Loading Error"
Set xCMods = Nothing
Exit Sub
End If
' 2. resolve hex input problem of negative line numbers with leading space (thx @Thunderframe)
s = "line"
Set lines = xCMods.DocumentElement.SelectNodes(s)
' loop thru all logical lines
For Each line In lines
pos = ErlPosInLine(line.Text)
If pos <= Len(line.Text) Then
' to do: add attribute to line node, if wanted
' correct line content
line.Text = Mid(line.Text, pos)
End If
Next
End Sub
Private Function lineNumber(node As Object) As Long
' Purpose: [B.] return logical line number within code module lines
' Param.: IXMLDomNode
' Method: XPath via preceding-sibling count plus one
Dim tag As String: tag = "line"
lineNumber = node.SelectNodes("preceding-sibling::" & tag).Length + 1
End Function
Private Function readCM(Optional modName = "*") As String
' Purpose: return code module line string (VBIDE) of a user defined module to be read into xml
' Call: called from [A.] refreshCM
' xCMods.LoadXML(readCM(sModName))
' Declare variable
Dim s As String
Dim md As CodeModule
If modName = "*" Then Exit Function
On Error GoTo OOPS
' get code module lines into string
Set md = Application.VBE.ActiveVBProject.VBComponents(modName).CodeModule ' MSAccess: Modules("modVBELines")
' change to xml tags
s = getTags(md.lines(1, md.CountOfLines))
' return
readCM = s
OOPS:
End Function
Private Function getTags(ByVal s As String, Optional mode = False) As String
' Purpose: prepares xml string to be loaded
' define constant
Const HEAD = "<?xml version=""1.0"" encoding=""utf-8""?>" & vbCrLf & "<cm>" & vbCrLf
' 1. change tag characters
s = Replace(Replace(s, "<", "<"), ">", ">")
' 2. change special characters (ampersand)
s = Replace(s, "&", "&")
' 3. change "_" points
s = Replace(s, "_" & vbCrLf, Chr(133) & vbLf)
' 4. define logical line entities
If Right(s, 2) = vbCrLf Then s = Left(s, Len(s) - 2)
s = HEAD & " <line>" & Replace(s, vbCrLf, "</line>" & vbCrLf & " <line>") & "</line>" & vbCrLf & "</cm>"
' debug xml tags if second function parameter is true (mode = True)
If mode Then Debug.Print s
' return
getTags = s
End Function
Sub testErlPosInLine()
' Purpose: Test Thunderframe's problem with ERL prefixes (underscores, " ",..) and hex inputs
Dim s As String
s = " _" & vbLf & " -1 xx"
MsgBox "|" & Mid(s, ErlPosInLine(s)) & "|" & vbNewLine & _
"prefix = |" & Mid(s, 1, ErlPosInLine(s) - 1) & "|"
End Sub
Private Function ErlPosInLine(ByVal s As String) As Integer
' Purpose: remove prefix (underscore, tab, " ",.. ) from numbered line
' cf: http://stackoverflow.com/questions/42716936/vba-to-remove-numbers-from-start-of-string-cell
Dim i As Long
For i = 1 To Len(s) ' loop each char
Select Case Mid$(s, i, 1) ' examine current char
Case " " ' permitted chars
Case "_"
Case vbLf, Chr(133), Chr(34)
Case "0" To "9": Exit For ' cut off point
Case Else: Exit For ' i is the cut off point
End Select
Next
If Mid$(s, i, 1) = "-" And Len(s) > 1 Then
If IsNumeric(Mid$(s, i + 1, 1)) Then i = i + 1
End If
' return
ErlPosInLine = i
' debug.print Mid$(s, i) '//strip lead
End Function
这篇关于VBA-通过模式搜索在VBE模块中查找所有编号的行的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
