Loop Though All UDF Names in Project

2020-02-29 05:51发布

This question: Searching for function usage in Excel VBA got me thinking about a process for automating a search for all UDFs being used in a spreadsheet. Something along the lines of:

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

Is this possible and if so, what would the syntax be for looping through all UDFs?

3条回答
啃猪蹄的小仙女
2楼-- · 2020-02-29 06:15
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

查看更多
▲ chillily
3楼-- · 2020-02-29 06:27

I tweaked Dee's answer so that it only looks for functions. I also changed the code to search across all modules & across all worksheets in the active workbook. I also tweaked the code to highlight a cell containing a UDF when it's found. This code isn't thoroughly tested but seems to work for me. More details about my additions:

  • In order to restrict the search to functions, i.e. exclude subroutines, I passed the declaration line of the procedure to the ProcKindString, allowing it to distinguish between subroutines and functions. I'm working in a very large workbook with over 20 worksheets and about 30 modules where I'd say over 90% of procedures are subroutines, so this was a performance booster for me.

  • In order to search through all modules, I added a function which finds all modules in the current project. The function is called GetModules and returns a collection of modules. The top level function FindAllUDFs then iterates over these modules, and from there on it's pretty much Dee's code.

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
查看更多
淡お忘
4楼-- · 2020-02-29 06:31

Okay, I'm going to do this the hard way, because I'm going to assume that you don't want to have to download the VBE classes from my repository to make this a bit easier to work with, but they're there as an example of what's possible regardless.

First, you'll need to add a reference to the Microsoft Visual Basic for Applications Extensibility 5.3 Library and allow VBA to access the editor by taking the following steps. (Assumes Office 2010)

  1. File
  2. Options
  3. Trust Center
  4. Trust Center Settings
  5. Macro Settings
  6. Check "Trust access to the VBA project object model".

Now we're ready to explore the code in the workbook, but first, some things to remember about what we're looking for here.

  1. Functions
  2. More specifically, Public Functions
  3. In standard *.bas modules (class functions can't be UDFs).
  4. That don't have Option Private Module

The code below works on the active vba project, but could be modified to take one as a parameter. It works with the quick test cases I provided below the Run sub, but I wouldn't guarantee that it works for all corner cases. Parsing is hard. This also just stores and prints the function signatures in the results collection. I imagine in reality you would want a function that returns them, so that you could loop through the collection looking for them in the workbook.

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
查看更多
登录 后发表回答