|
Sub UDFSOFACTIVEWORKBOOK() Dim sh As Worksheet, r As Range, dic As Object, i As Long, temp As String, vbcomp, s() As String, UDF As String For i = 1 To ActiveWorkbook.VBProject.VBComponents.Count Set vbcomp = ActiveWorkbook.VBProject.VBComponents(i) If vbcomp.Type = 1 Then temp = temp & vbCrLf & vbcomp.CodeModule.Lines(1, 65536) Next s = Split(temp, vbCrLf) temp = "" For i = 0 To UBound(s) If s(i) Like "Function * As *" Then temp = temp & "@" & "=" & Trim(Split(Split(s(i), "(")(0), "Function")(1)) & "(" '--->All functions with or without parameters Next Set dic = CreateObject("scripting.dictionary") For Each sh In Sheets For Each r In sh.UsedRange If r.HasFormula Then If InStr(temp, "@" & Split(r.Formula, "(")(0)) > 0 Then UDF = r.Formula & "udf" Else UDF = "" End If If Not dic.exists(r.Formula) Then dic.Add r.Formula, UDF End If Next Next Debug.Print "All functions used in activesheet" & vbCrLf & String(50, "-") & vbCrLf & Join(dic.keys, vbCrLf) & vbCrLf & vbCrLf '列出一个工作簿中所有函数 Debug.Print "All user define functions used in activesheet" & vbCrLf & String(50, "-") & vbCrLf & Replace(Join(Filter(dic.items, "udf"), vbCrLf), "udf", "") '列出一个工作簿中所有已使用的自定义函数 Set dic = Nothing End Sub |
|