vba - 循环遍历项目中的所有 UDF 名称

Question

这个问题：Searching for function usage in Excel VBA让我想到了一个自动搜索电子表格中使用的所有 UDF 的过程。类似于以下内容：

For Each UDF in Module1
    If Cells.Find(What:=UDF.Name, After:="A1", LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False) Then
        MsgBox UDF.Name & " is in use"
    End If
Next UDF

这可能吗？如果可以，遍历所有 UDF 的语法是什么？

score 7 · Accepted Answer

好的，我会以艰难的方式做到这一点，因为我会假设您不想必须从我的存储库中下载 VBE 类以使其更易于使用，但它们是有一个例子说明无论如何都是可能的。

首先，您需要添加对 Microsoft Visual Basic for Applications Extensibility 5.3 Library的引用，并允许 VBA 通过执行以下步骤访问编辑器。（假设 Office 2010）

文件
选项
信托中心
信任中心设置
宏设置
选中“信任对 VBA 项目对象模型的访问”。

现在我们已准备好探索工作簿中的代码，但首先，需要记住一些关于我们在此处查找的内容的事项。

功能
更具体地说，公共职能
在标准 *.bas 模块中（类函数不能是 UDF）。
没有选项私有模块

下面的代码适用于活动的 vba 项目，但可以修改为将其作为参数。它适用于我在子下方提供的快速测试用例Run，但我不能保证它适用于所有极端情况。解析很难。这也只是存储和打印集合中的函数签名results。我想实际上你会想要一个返回它们的函数，这样你就可以遍历集合在工作簿中寻找它们。

Option Explicit

Private Sub Run()
    Dim results As New Collection

    Dim component As VBIDE.VBComponent
    For Each component In Application.VBE.ActiveVBProject.VBComponents

        If component.Type = vbext_ct_StdModule Then
            ' find public functions with no arguments
            Dim codeMod As CodeModule
            Set codeMod = component.CodeModule

            If InStr(1, codeMod.Lines(1,codeMod.CountOfDeclarationLines), "Option Private Module") = 0 Then

                Dim lineNumber As Long
                lineNumber = codeMod.CountOfDeclarationLines + 1

                Dim procName As String
                Dim procKind As vbext_ProcKind
                Dim signature As String

                ' loop through all lines in the module
                While (lineNumber < codeMod.CountOfLines)
                    procName = codeMod.ProcOfLine(lineNumber, procKind) 'procKind is an OUT param

                    Dim lines() As String
                    Dim procLineCount As Long

                    procLineCount = codeMod.ProcCountLines(procName, procKind)
                    lines = Split(codeMod.lines(lineNumber, procLineCount), vbNewLine)

                    Dim i As Long
                    For i = 0 To UBound(lines)
                        If lines(i) <> vbNullString And Left(Trim(lines(i)), 1) <> "'" Then
                            signature = lines(i)
                            Exit For
                        End If
                    Next

                    ' this would need better parsing, but should be reasonably close
                    If InStr(1, signature, "Public Function", vbTextCompare) > 0 Then 'first make sure we have a public function
                        results.Add signature
                    End If

                    lineNumber = lineNumber + procLineCount + 1 ' skip to next procedure
                Wend

            End If

        End If
    Next component

    Dim str
    For Each str In results
        Debug.Print str
    Next
End Sub

Public Function foo()

End Function

Private Function bar()

End Function

Public Function qwaz(duck)

End Function

score 5 · Accepted Answer

Option Explicit

' Add reference to Microsoft Visual Basic for Applications Extensibility 5.3 Library

Public Sub FindFunctionUsage()
    Dim udfs
    udfs = ListProcedures("Module1")
    If Not IsArray(udfs) Then _
        Exit Sub

    Dim udf
    Dim findResult

    For Each udf In udfs
        Set findResult = Cells.Find(What:="=" & udf, After:=Cells(1), LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False)

        If Not findResult Is Nothing Then _
            MsgBox udf & " is in use"
    Next udf
End Sub

' Source for ListProcedures : http://www.cpearson.com/excel/vbe.aspx
Private Function ListProcedures(moduleName As String)
        Dim VBProj As VBIDE.VBProject
        Dim VBComp As VBIDE.VBComponent
        Dim CodeMod As VBIDE.CodeModule
        Dim LineNum As Long
        Dim NumLines As Long
        Dim WS As Worksheet
        Dim rng As Range
        Dim ProcName As String
        Dim ProcKind As VBIDE.vbext_ProcKind

        Set VBProj = ActiveWorkbook.VBProject
        Set VBComp = VBProj.VBComponents(moduleName)
        Set CodeMod = VBComp.CodeModule

        Dim result
        With CodeMod
            LineNum = .CountOfDeclarationLines + 1
            Do Until LineNum >= .CountOfLines
                ProcName = .ProcOfLine(LineNum, ProcKind)
                If ProcKindString(ProcKind) = "Sub Or Function" Then
                    If IsArray(result) Then
                        ReDim Preserve result(LBound(result) To UBound(result) + 1)
                    Else
                        ReDim result(0 To 0)
                    End If
                    result(UBound(result)) = ProcName
                End If

                LineNum = .ProcStartLine(ProcName, ProcKind) + _
                        .ProcCountLines(ProcName, ProcKind) + 1
            Loop
        End With
        ListProcedures = result
    End Function

    Function ProcKindString(ProcKind As VBIDE.vbext_ProcKind) As String
        Select Case ProcKind
            Case vbext_pk_Get
                ProcKindString = "Property Get"
            Case vbext_pk_Let
                ProcKindString = "Property Let"
            Case vbext_pk_Set
                ProcKindString = "Property Set"
            Case vbext_pk_Proc
                ProcKindString = "Sub Or Function"
            Case Else
                ProcKindString = "Unknown Type: " & CStr(ProcKind)
        End Select
    End Function

' Content of Module1
Public Sub Sub1()

End Sub

Public Function Func1(ByRef x As Range)

End Function

Public Sub Sub2()

End Sub

在此处输入图像描述

score 0 · Accepted Answer

我调整了 Dee 的答案，使它只寻找功能。我还更改了代码以搜索所有模块和活动工作簿中的所有工作表。我还调整了代码以在找到包含 UDF 的单元格时突出显示它。此代码未经彻底测试，但似乎对我有用。关于我的补充的更多细节：

为了限制对函数的搜索，即排除子程序，我将过程的声明行传递给 ProcKindString，使其能够区分子程序和函数。我正在处理一个非常大的工作簿，其中包含 20 多个工作表和大约 30 个模块，我想说超过 90% 的过程是子例程，所以这对我来说是一个性能提升器。
为了搜索所有模块，我添加了一个查找当前项目中所有模块的功能。该函数称为 GetModules 并返回一个模块集合。顶层函数 FindAllUDFs 然后遍历这些模块，从那里开始它几乎是 Dee 的代码。



Option Explicit

' Add reference to Microsoft Visual Basic for Applications Extensibility 5.3 Library

Public Sub FindAllUDFs()
    Dim allModules As Collection
    Set allModules = GetModules()
    Dim module As Variant
    For Each module In allModules
        FindFunctionUsage (module)
        Next module
    End Sub

Public Sub FindFunctionUsage(moduleName As String)
    Application.StatusBar = "Looking for UDF usages in module "
    Dim udfs
    udfs = ListFunctions(moduleName)
    If Not IsArray(udfs) Then _
    Exit Sub

    Dim udf
    Dim findResult
    Dim sheet

    For Each sheet In ActiveWorkbook.Worksheets
    sheet.Activate
        For Each udf In udfs
            Application.StatusBar = "Searching... Module: " & moduleName _
            & " Sheet: " & sheet.name & " UDF: " & udf
            Set findResult = Cells.Find(What:="=" & udf, After:=Cells(1), LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False)

            If Not findResult Is Nothing Then
                findResult.Activate
                MsgBox udf & " is in use"
            End If
        Next udf
    Next sheet
    Application.StatusBar = "Completed Search in " & moduleName
End Sub

    Private Function ListFunctions(moduleName As String)
        Dim VBProj As VBIDE.VBProject
        Dim VBComp As VBIDE.VBComponent
        Dim codeMod As VBIDE.CodeModule
        Dim LineNum As Long
        Dim NumLines As Long
        Dim WS As Worksheet
        Dim rng As Range
        Dim procName As String
        Dim procKind As VBIDE.vbext_ProcKind
        Dim procDecl As String
        Dim procDeclLine As Integer
        Set VBProj = ActiveWorkbook.VBProject
        Set VBComp = VBProj.VBComponents(moduleName)
        Set codeMod = VBComp.CodeModule

        Dim result
        With codeMod
            LineNum = .CountOfDeclarationLines + 1
            Do Until LineNum >= .CountOfLines
                procName = .ProcOfLine(LineNum, procKind)
                procDeclLine = .procBodyLine(procName, procKind)
                procDecl = .lines(procDeclLine, 1)
                If ProcKindString(procKind, procDecl) = "Function" Then
                    If IsArray(result) Then
                        ReDim Preserve result(LBound(result) To UBound(result) + 1)
                    Else
                        ReDim result(0 To 0)
                    End If
                    result(UBound(result)) = procName
                End If

                LineNum = .ProcStartLine(procName, procKind) + _
                .ProcCountLines(procName, procKind) + 1
            Loop
        End With
        ListFunctions = result
    End Function

    Function ProcKindString(procKind As VBIDE.vbext_ProcKind, procBodyLine As String) As String
        Select Case procKind
        Case vbext_pk_Get
            ProcKindString = "Property Get"
        Case vbext_pk_Let
            ProcKindString = "Property Let"
        Case vbext_pk_Set
            ProcKindString = "Property Set"
        Case vbext_pk_Proc
            If InStr(1, procBodyLine, "Sub ", vbBinaryCompare) > 0 Then
                ProcKindString = "Sub"
            Else
                ProcKindString = "Function"
            End If
        Case Else
            ProcKindString = "Unknown Type: " & CStr(procKind)
        End Select
    End Function

    Function GetModules() As Collection
        Dim modNames As New Collection
        Dim wb As Workbook
        Dim l As Long

        Set wb = ThisWorkbook

        For l = 1 To wb.VBProject.VBComponents.Count
            With wb.VBProject.VBComponents(l)
                If .Type = 1 Then modNames.Add .name
            End With
        Next
        Set wb = Nothing
        Set GetModules = modNames

    End Function

vba - 循环遍历项目中的所有 UDF 名称

3 回答 3

Related

Reference