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的语法是什么？

Answer 1

好吧，我将以艰难的方式做到这一点，因为我会假设你不想让download the VBE classes from my repository让这更容易合作，但他们'在那里作为一个可能的例子，无论如何。

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

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

现在我们已经准备好探索工作簿中的代码，但首先要记住我们在这里寻找的内容。

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

下面的代码适用于活动的vba项目，但可以修改为将其作为参数。它适用于我在Run子下面提供的快速测试用例，但我不保证它适用于所有极端情况。解析 hard 。这也只是在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

Answer 2

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

enter image description here

Answer 3

我调整了Dee的答案，使其仅查找功能。我还更改了代码以在活动工作簿中的所有模块和所有工作表中进行搜索。我还对代码进行了调整，以突出显示找到包含UDF的单元格。此代码尚未经过全面测试，但似乎对我有用。有关我添加的内容的更多详细信息：

为了将搜索限制在功能范围内，即排除子例程，我将过程的声明行传递给了 ProcKindString，允许它区分子程序和功能。我正在处理一个非常大的工作簿，其中包含20多个工作表和大约30个模块，其中90％以上的过程都是子例程，所以这是一个对我来说是性能的提升。
为了搜索所有模块，我添加了一个函数来查找当前项目中的所有模块。该函数称为GetModules，并返回模块的集合。然后，顶层函数FindAllUDF遍历这些模块，从那里开始，这几乎是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

循环遍历项目中的所有数据库名称

3 个答案: