您的位置:首页 > 其它

列出一个工作簿中所有已使用的自定义函数

2007-08-06 00:30 393 查看
需要添加对VB项目的信任

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
内容来自用户分享和网络整理,不保证内容的准确性,如有侵权内容,可联系管理员处理 点击这里给我发消息
标签: 
相关文章推荐