是否可以为函数分配别名?
Is it Possible to Assign an Alias to a Function?
我正在写一个简单的函数,比如:
Function myFunction() As Variant
'Some rules
End Function
对于上述功能,是否可以像调用 API 一样分配一个 Alias?
显然这不是正确的语法,但你明白了:
Function myFunction() Alias myFunc As Variant
'Some rules
End Function
这将允许我使用任一名称:
Sub Test()
Debug.Print myFunction
Debug.Print myFunc
End Sub
简单的VBA例子(没有类)
因为你称自己为 TheNotSoGuru,请尝试以下相对简单的方法:而不是像 API 13=] 定义你必须在一个用户定义的 alias() 函数 中编写你的别名定义。
调用测试程序
这向您展示了如何使用 ONE 用户定义的 alias
函数调用您的别名;第一个参数是你的别名 Name 作为字符串,其他参数定义了原始函数本身的可能参数:
Option Explicit ' declaration head of your code module
Sub Test()
Debug.Print "0) Original Function", myFunction
Debug.Print "1) alias(""(myFunc1"")", alias("myFunc1")
Debug.Print "2) alias(""(myFunc2"")", alias("myFunc2") ' too less arguments
Debug.Print "2) alias(""(myFunc2"",false)", alias("myFunc2", False)
End Sub
示例函数
第一个例子需要无参数; 第二个示例 演示了一个不正确和正确的别名函数调用 - 原始函数处理布尔参数(True
或 False
)的输入。
Function myFunction() As Variant
'Some rules
'...
'return result
myFunction = "Result from myFunction"
End Function
Function myFunctionWithOneArgument(Optional ByVal b As Boolean = True) As String
'Some rules
If b Then
myFunctionWithOneArgument = "result from myFunctionWithOneArgument " & "okay"
Else
myFunctionWithOneArgument = "result from myFunctionWithOneArgument " & "without comment"
End If
End Function
===============
Example of an Alias() function
您负责将您的别名定义插入到别名函数中。
它甚至允许您通过错误处理引发 450 错误 "Wrong number of arguments ..." 来强制输入正确数量的参数。如果发生错误,消息框会显示一条错误消息。
Function alias(ByVal sFunc, Optional arg1, Optional arg2, Optional arg3)
On Error GoTo oops ' error handler
Select Case sFunc & "" ' check your own aliases as string values
Case "myFunc1", "1" ' your alias Definition(s)
alias = myFunction ' return original function myFunction
Case "myFunc2", "One" ' see above
' defines if one argument is needed here:
If IsMissing(arg1) Then Err.Raise (450) ' too less arguments if arg1 is missing
alias = myFunctionWithOneArgument(arg1)
Case Else
alias = "Unknown function alias " & sFunc
End Select
EverythingOkay: Exit Function
oops:
MsgBox "Function: " & sFunc & vbNewLine & vbNewLine & _
"Error No: " & Err.Number & vbNewLine & _
Err.Description, vbExclamation, "Error - Wrong number of arguments"
Err.Clear
End Function
我不明白为什么 VBA 函数需要一个 VBA 别名。
API 别名用于引用 DLL 中的函数或其他对象,
如果它是 "given name" 不能在需要它的模块中使用。
Alias —— Indicates that the procedure being called has another
name in the DLL. This is useful when the external procedure name is
the same as a keyword. You can also use Alias when a DLL procedure has
the same name as a public variable, constant, or any other procedure in
the same scope. Alias is also useful if any characters in the DLL
procedure name aren't allowed by the DLL naming convention. (Source)
...但是为了回答您的问题,当然您可以为函数创建备用名称,只需对您的代码稍作修改:
Your Function:
Function myFunction() As Variant
'Some rules
End Function
Assign an alternate name:
Function myFunc() As Variant
myFunc = myFunction
End Function
This would allow you to use either name:
Sub Test()
Debug.Print myFunction
Debug.Print myFunc
End Sub
编辑:"Can't remember UDF Names"
(我说我不明白你为什么要这样做,我以为你没有我的记忆!现在我理解您的推理,为 same 函数指定多个名称!)
什么, 你还没有记住所有自定义 VBA 函数的名称和语法,除了 1000 个内置函数、过程和对象,以及看似 无限列表 属性、方法和 class 名称??
我也没有。
在 VBA 中编码时有助于触发我的记忆的一个功能是
列表 Properties/Methods.
开始输入函数名称 或过程,然后按 Ctrl+J,并且你会得到一个列表,其中包含自定义的和内置函数、方法、过程等.**
我注意到您的示例函数名称都以“my
”开头。这可能只是为了说明目的,但是,像这样的特定命名约定也有助于在 Properties/Methods 对话框中将您的函数分组在一起。
- 另请参阅:100+ 列表 VBA Keyboard Shortcuts (以防您忘记组合键!)
更多方式来记住事物的工作原理和它们的名称:
您还可以向 UDF(用户定义的函数)添加描述,在工作表上输入函数名称时会出现该描述:
参见:How to put a 'Tooltip' on a user-defined function
相关:
Add a Description to a User Defined Function in Excel(没有VBA)
The Quest for the Excel Custom Function Tooltip (C#)
比描述更进一步,注册用户定义函数不仅允许为函数[=205=创建描述],还有关于每个 函数参数 及其数据类型的详细信息;您甚至可以指定快捷键,添加自定义链接“帮助" files/pages,甚至为 UDF 分配一个 Category。
这些扩展属性显示在 Insert Function
对话框中,可通过单击公式栏左侧的 按钮或点击 Shift+F3:
Excel 没有用于编辑参数描述的内置界面,因此需要 VBA。很难找到相关文档。
关于注册用户定义函数的代码和信息
-:
创建功能区按钮以列出 VBA 程序
我还没有尝试过这个,但我可以看到它非常方便,特别是因为它很容易进一步定制,也许还有项目特定的函数列表和其他信息。
可以将一个按钮添加到功能区,单击该按钮会显示 VBA procedures/functions 的列表,使用 XML 和 VBA 显示用户表单一个按钮。还有一个选项可以将程序列表保存到文本文件。
您已经可以通过“开发人员”选项卡上的“宏”按钮查看工作簿中的过程。但是,只有模块中和工作表中的无参数子例程才会显示在“宏”对话框中。带有参数的函数和子例程不会显示。本专栏中描述的代码显示了工作簿中的所有子例程和函数。
更多信息和完整代码可用here.
VBA写VBA代码的代码!?
通过以编程方式操作 VBA 编辑器 (VBE),您可以在 VBA 中编写代码来读取或修改其他 VBA 项目、模块和过程,并可用于自动执行与开发相关的任务。这叫做 extensibility 因为它扩展了 editor -- 你可以使用 VBA 代码创建新的 VBA 代码。您可以使用这些功能来编写创建、更改或删除 VBA 模块和代码过程的自定义过程。
令人惊叹的 Chip Pearson 再次做到了,此处 提供了详细的说明和完整的代码,了解可扩展性可以为您做的一些有趣的事情。
Chip页面部分代码列表(here):
- Add/Delete/Rename 项目中的模块
- Add/Delete/Rename 模块中的过程
- 在项目之间复制模块
- 在代码模块中创建新过程
- 创建事件过程
- 列出模块中的所有过程
- 阅读程序声明
- 在模块中搜索文本
- 修复 VBE 中的屏幕闪烁问题
- 将 VBComponent 导出到文本文件
- 测试 VBComponent 是否存在
- 确定与 VBProject 关联的工作簿
- 计算 Module/Project/Component
中的代码行数
这些方法使用 VBA Extensibility [library] (http://www.exceltoolset.com/setting-a-reference-to-the-vba-extensibility-library-by-code/)(参考)并要求以编程方式访问 VBA 项目,这是 Excel 选项中的一项安全设置。有关详细信息,请参阅 Chip 的页面。
Chip 的页面在 Customizing Menus with VBA 上也提供了很好的信息和代码,这可能有助于使开发人员 自己的 工作更轻松。
看似"forgotten" VBA 的能力,如果 控制 甚至 拦截 内置命令。这也可以使开发人员受益(尤其是记忆力不佳的开发人员!)...来自 Microsoft here.
的更多信息和示例
通过相似度搜索别名
A) 简介
Your Comment as of 1/22: "The issue is not that I necessarily want to call out the alias intentionally, it's an issue of forgetting what I may have named a function to begin with (ie. verifyRange
vs verifyRng
). If I knew I was calling the alias name to begin with then I wouldn't need to call the alias. But your solution does work and it was very well thought out."
由于您在上面引用的评论中的示例:当您 稍微修改了您的初始问题 时,我想到了一个替代解决方案并将其添加为一个独立的 new回答:
► You could take some advantage of using a so called SoundEx
search to group procedure names based on a phonetic algorithm.
方法:一个Soundex代码识别一组发音相似的术语、名称或... ►过程名称。如果您将此与通过所有现有 procedures/functions 的 VBIDE 列表的循环相结合(不要忘记设置引用 ),您能够列出最有可能的别名。
Example result
1/1 Project(s): "VBAProject" (D:\Excel\test.xlsm)
**Project name: "VBAProject" ** (Host Project)
++SoundEx("verifyRange")="V616"
-- Found -- Procedure/Function name(s) --------- ------------------
[Prc: Sub] verifyRng in Std Module modTest1 Line#: 2/[Body: 3]
[Prc: Sub] verifyRange in Std Module modSortDict Line#: 6/[Body: 6]
注意:此方法基于六种语音分类构建压缩字母数字代码 人类语音(双唇、唇齿音、牙音、牙槽音、软腭音和声门音),去除人声和 'H'、'W' 和 [=128] 的一些出现=];该代码由第一个大写字母和后面的三个数字组成(如果找不到更多辅音,则用 0
填充)。顺便说一句,起源可以追溯到 1800 年代后期,用于 索引美国人口普查记录 。
链接
Find the word which I closest to the particular string?
http://www.creativyst.com/Doc/Articles/SoundEx1/SoundEx1.htm#JavaScriptCode
https://en.wikipedia.org/wiki/Soundex
Soundex 示例
为了演示 soundex 编码,请尝试以下具有相同结果的示例调用:
Sub testSoundEx()
Dim i As Integer
Dim a()
a = Array("verifyRange", "verifyRng", "vrfRanges")
Debug.Print "Proc name", "SoundEx Code": Debug.Print String(50, "-")
For i = LBound(a) To UBound(a)
Debug.Print a(i), SoundEx(a(i))
Next i
End Sub
SoundEx函数
Function SoundEx(ByVal s As String) As String
' Site:
' Source: Developed by Richard J. Yanco
' Method: follows the Soundex rules given at http://home.utah-inter.net/kinsearch/Soundex.html
Dim Result As String, c As String * 1
Dim Location As Integer
s = UCase(s) ' use upper case
' First character must be a letter
If Len(Trim(s)) = 0 Then
Exit Function
ElseIf Asc(Left(s, 1)) < 65 Or Asc(Left(s, 1)) > 90 Then
SoundEx = ""
Exit Function
Else
' (1) Convert to Soundex: letters to their appropriate digit,
' A,E,I,O,U,Y ("slash letters") to slashes
' H,W, and everything else to zero-length string
Result = Left(s, 1)
For Location = 2 To Len(s)
Result = Result & Category(Mid(s, Location, 1))
Next Location
' (2) Remove double letters
Location = 2
Do While Location < Len(Result)
If Mid(Result, Location, 1) = Mid(Result, Location + 1, 1) Then
Result = Left(Result, Location) & Mid(Result, Location + 2)
Else
Location = Location + 1
End If
Loop
' (3) If category of 1st letter equals 2nd character, remove 2nd character
If Category(Left(Result, 1)) = Mid(Result, 2, 1) Then
Result = Left(Result, 1) & Mid(Result, 3)
End If
' (4) Remove slashes
For Location = 2 To Len(Result)
If Mid(Result, Location, 1) = "/" Then
Result = Left(Result, Location - 1) & Mid(Result, Location + 1)
End If
Next
' (5) Trim or pad with zeroes as necessary
Select Case Len(Result)
Case 4
SoundEx = Result
Case Is < 4
SoundEx = Result & String(4 - Len(Result), "0")
Case Is > 4
SoundEx = Left(Result, 4)
End Select
End If
End Function
SoundEx()
调用的辅助函数
这个辅助函数 return 是一个基于语音分类的字母代码(见上面的注释):
Private Function Category(c) As String
' Returns a Soundex code for a letter
Select Case True
Case c Like "[AEIOUY]"
Category = "/"
Case c Like "[BPFV]"
Category = "1"
Case c Like "[CSKGJQXZ]"
Category = "2"
Case c Like "[DT]"
Category = "3"
Case c = "L"
Category = "4"
Case c Like "[MN]"
Category = "5"
Case c = "R"
Category = "6"
Case Else 'This includes H and W, spaces, punctuation, etc.
Category = ""
End Select
End Function
► Solution to your issue - Example Call to get Functions by Alias
B) 内存问题或如何记忆
您可以使用以下示例调用通过语法 listProc {function name string}
搜索 procedure/function 别名,例如listProc "verifyRange"
并且您会在 Visual Basic 编辑器 (VBE) 的 即时 Window 中得到所有找到的别名 的压缩列表 ):
Sub Test()
listProc "verifyRange" ' possibly gets verifyRange AND verifyRng via SoundEx "V616"
'listProc "verify" ' possibly gets nothing, as SoundEx "V610" has no fourth consonant
'listProc '[ displays ALL procedures without SoundEx Filter ]
End Sub
注意: 请记住 SoundEx 代码(例如 "V616" 代表 verifyRange
)的长度限制为四个字母数字人物。
如果您只查找 "verify"(= 3 个辅音 V+r+f),您会得到 "V610" 而不是 "verifyRange" 或 "verifyRng"(V+r+ f+r)。
在这种情况下,您应该搜索一对变体。
=============================
主程序listProc
=====================
Sub listProc(Optional ByVal sFuncName As String)
' Purpose: display procedures using a SoundEx Filter
' Call: 0 arguments or empty argument - ALL procedures without filter
' 1 argument (not empty) - procedures found via SoundEx
' Note: requires reference to Microsoft Visual Basic for Applications Extensibility 5.3
' Declare variables to access the macros in the workbook.
Dim VBAEditor As VBIDE.VBE ' VBE
Dim objProject As VBIDE.VBProject ' Projekt
Dim objComponent As VBIDE.VBComponent ' Modul
Dim objCode As VBIDE.CodeModule ' Codeblock des Moduls
' Declare other miscellaneous variables.
Dim sProcName As String
Dim sndx As String, sndx2 As String
Dim pk As vbext_ProcKind ' proc kind (Sub, Function, Get, Let)
Dim strPK As String, sTyp As String
Dim iLine As Integer, iBodyLine As Integer, iStartLine As Integer
Dim i As Integer
Dim bShow As Boolean ' show procedure name
Dim bSoundEx As Boolean
If Len(Trim(sFuncName)) > 0 Then bSoundEx = True ' show alle procedures!
' ========================================
' Get the project details in the workbook.
' ========================================
Set VBAEditor = Application.VBE
Set objProject = VBAEditor.ActiveVBProject
' Set objProject = VBAEditor.VBProjects("MyProcject") ' 1-based, project name or item number
For i = 1 To VBAEditor.VBProjects.Count ' show name, filename, buildfilename (DLL)
Debug.Print i & "/" & _
VBAEditor.VBProjects.Count & " Project(s): """ & _
VBAEditor.VBProjects(i).Name & """ (" & VBAEditor.VBProjects(i).filename & ")"
Next i
' get SoundEx of Function name
sndx2 = SoundEx(sFuncName)
' ==================
' ? PROJECT NAME
' ==================
' objProject.Type ...vbext_pt_HostProject 100 Host-Project
' ...vbext_pt_StandAlone 101 Standalone-Project
Debug.Print "**Project name: """ & objProject.Name & """ ** (" & _
IIf(objProject.Type = 100, "Host Project", "Standalone") & ")"
If bSoundEx Then Debug.Print "++SoundEx(""" & sFuncName & """)=""" & sndx2 & """" & _
vbNewLine & "-- Found -- Procedure/Function name(s)"
' Iterate through each component (= Module) in the project.
For Each objComponent In objProject.VBComponents ' alle MODULE
' Find the code module for the project (Codeblock in current component/=module).
Set objCode = objComponent.CodeModule
' =============
' ? MODULE NAME
' =============
If objCode.CountOfLines > 0 And Not bSoundEx Then
Debug.Print " *** " & _
sModType(objComponent.Type) & " ** " & objComponent.Name & " ** "
End If
' Scan through the code module, looking for procedures.
' Durch alle Codezeilen des jeweiligen Moduls gehen
iLine = 1
Do While iLine < objCode.CountOfLines ' alle Zeilen durchackern (1/End ...)
' =================
' Get Procedurename ' !! SETZT AUTOMATISCH >> pk << !!
' =================
sProcName = objCode.ProcOfLine(iLine, pk) ' jede nächste Zeile auf Prozedurbeginn checken
If sProcName <> "" Then ' ohne Declaration head
' -----------------
' Found a procedure
' -----------------
' a) Get its details, and ...
strPK = pk ' 0-Prc|1-Let/2-Set/3-Get Werte abfangen !!!
'' iStartLine = objCode.ProcStartLine(sProcName, strPK) ' here = iLine !!
iBodyLine = objCode.ProcBodyLine(sProcName, strPK) ' Zeilennr mit Sub/Function/L/S/Get
sTyp = sPrcType(objCode.Lines(iBodyLine, 1)) ' Sub|Fct|Prp
' b) Check Soundex
If bSoundEx Then
sndx = SoundEx(sProcName)
If sndx = sndx2 Or UCase(sProcName) = UCase(sFuncName) Then
bShow = True
Else
bShow = False
End If
Else
bShow = True
End If
' ==============
' c) ? PROC NAME
' --------------
If bShow Then
Debug.Print " " & "[" & sPK(strPK) & ": " & sTyp & "] " & _
sProcName & IIf(bSoundEx, " in " & sModType(objComponent.Type) & " " & objComponent.Name, "") & vbTab, _
"Line#: " & iLine & "/[Body: " & iBodyLine & "]"
End If
' -------------------------------------------
' d) Skip to the end of the procedure !
' => Add line count to current line number
' -------------------------------------------
iLine = iLine + objCode.ProcCountLines(sProcName, pk)
Else
' This line has no procedure, so => go to the next line.
iLine = iLine + 1
End If
Loop
Next objComponent
' Clean up and exit.
Set objCode = Nothing
Set objComponent = Nothing
Set objProject = Nothing
End Sub
3 主程序的辅助函数 listProc
这些辅助函数 return 过程和模块的附加信息:
Function sPK(ByVal prockind As Long) As String
' Purpose: returns short description of procedure kind (cf ProcOfLine arguments)
Dim a(): a = Array("Prc", "Let", "Set", "Get")
sPK = a(prockind)
End Function
Function sPrcType(ByVal sLine As String) As String
' Purpose: returns procedure type abbreviation
If InStr(sLine, "Sub ") > 0 Then
sPrcType = "Sub" ' sub
ElseIf InStr(sLine, "Function ") > 0 Then
sPrcType = "Fct" ' function
Else
sPrcType = "Prp" ' property (Let/Set/Get)
End If
End Function
Function sModType(ByVal moduletype As Integer) As String
' Purpose: returns abbreviated module type description
Select Case moduletype
Case 100
sModType = "Tab Module"
Case 1
sModType = "Std Module"
Case 2
sModType = "CLS Module"
Case 3
sModType = "Frm Module"
Case Else
sModType = "?"
End Select
End Function
我正在写一个简单的函数,比如:
Function myFunction() As Variant
'Some rules
End Function
对于上述功能,是否可以像调用 API 一样分配一个 Alias?
显然这不是正确的语法,但你明白了:
Function myFunction() Alias myFunc As Variant
'Some rules
End Function
这将允许我使用任一名称:
Sub Test()
Debug.Print myFunction
Debug.Print myFunc
End Sub
简单的VBA例子(没有类)
因为你称自己为 TheNotSoGuru,请尝试以下相对简单的方法:而不是像 API 13=] 定义你必须在一个用户定义的 alias() 函数 中编写你的别名定义。
调用测试程序
这向您展示了如何使用 ONE 用户定义的 alias
函数调用您的别名;第一个参数是你的别名 Name 作为字符串,其他参数定义了原始函数本身的可能参数:
Option Explicit ' declaration head of your code module
Sub Test()
Debug.Print "0) Original Function", myFunction
Debug.Print "1) alias(""(myFunc1"")", alias("myFunc1")
Debug.Print "2) alias(""(myFunc2"")", alias("myFunc2") ' too less arguments
Debug.Print "2) alias(""(myFunc2"",false)", alias("myFunc2", False)
End Sub
示例函数
第一个例子需要无参数; 第二个示例 演示了一个不正确和正确的别名函数调用 - 原始函数处理布尔参数(True
或 False
)的输入。
Function myFunction() As Variant
'Some rules
'...
'return result
myFunction = "Result from myFunction"
End Function
Function myFunctionWithOneArgument(Optional ByVal b As Boolean = True) As String
'Some rules
If b Then
myFunctionWithOneArgument = "result from myFunctionWithOneArgument " & "okay"
Else
myFunctionWithOneArgument = "result from myFunctionWithOneArgument " & "without comment"
End If
End Function
=============== Example of an Alias() function
您负责将您的别名定义插入到别名函数中。 它甚至允许您通过错误处理引发 450 错误 "Wrong number of arguments ..." 来强制输入正确数量的参数。如果发生错误,消息框会显示一条错误消息。
Function alias(ByVal sFunc, Optional arg1, Optional arg2, Optional arg3)
On Error GoTo oops ' error handler
Select Case sFunc & "" ' check your own aliases as string values
Case "myFunc1", "1" ' your alias Definition(s)
alias = myFunction ' return original function myFunction
Case "myFunc2", "One" ' see above
' defines if one argument is needed here:
If IsMissing(arg1) Then Err.Raise (450) ' too less arguments if arg1 is missing
alias = myFunctionWithOneArgument(arg1)
Case Else
alias = "Unknown function alias " & sFunc
End Select
EverythingOkay: Exit Function
oops:
MsgBox "Function: " & sFunc & vbNewLine & vbNewLine & _
"Error No: " & Err.Number & vbNewLine & _
Err.Description, vbExclamation, "Error - Wrong number of arguments"
Err.Clear
End Function
我不明白为什么 VBA 函数需要一个 VBA 别名。
API 别名用于引用 DLL 中的函数或其他对象, 如果它是 "given name" 不能在需要它的模块中使用。
Alias —— Indicates that the procedure being called has another name in the DLL. This is useful when the external procedure name is the same as a keyword. You can also use Alias when a DLL procedure has the same name as a public variable, constant, or any other procedure in the same scope. Alias is also useful if any characters in the DLL procedure name aren't allowed by the DLL naming convention. (Source)
...但是为了回答您的问题,当然您可以为函数创建备用名称,只需对您的代码稍作修改:
Your Function:
Function myFunction() As Variant 'Some rules End Function
Assign an alternate name:
Function myFunc() As Variant myFunc = myFunction End Function
This would allow you to use either name:
Sub Test() Debug.Print myFunction Debug.Print myFunc End Sub
编辑:"Can't remember UDF Names"
(我说我不明白你为什么要这样做,我以为你没有我的记忆!现在我理解您的推理,为 same 函数指定多个名称!)
什么, 你还没有记住所有自定义 VBA 函数的名称和语法,除了 1000 个内置函数、过程和对象,以及看似 无限列表 属性、方法和 class 名称??
我也没有。
在 VBA 中编码时有助于触发我的记忆的一个功能是 列表 Properties/Methods.
开始输入函数名称 或过程,然后按 Ctrl+J,并且你会得到一个列表,其中包含自定义的和内置函数、方法、过程等.**
我注意到您的示例函数名称都以“my
”开头。这可能只是为了说明目的,但是,像这样的特定命名约定也有助于在 Properties/Methods 对话框中将您的函数分组在一起。
- 另请参阅:100+ 列表 VBA Keyboard Shortcuts (以防您忘记组合键!)
更多方式来记住事物的工作原理和它们的名称:
您还可以向 UDF(用户定义的函数)添加描述,在工作表上输入函数名称时会出现该描述:
参见:How to put a 'Tooltip' on a user-defined function
相关:
Add a Description to a User Defined Function in Excel(没有VBA)
The Quest for the Excel Custom Function Tooltip (C#)
比描述更进一步,注册用户定义函数不仅允许为函数[=205=创建描述],还有关于每个 函数参数 及其数据类型的详细信息;您甚至可以指定快捷键,添加自定义链接“帮助" files/pages,甚至为 UDF 分配一个 Category。
这些扩展属性显示在 Insert Function
对话框中,可通过单击公式栏左侧的
Excel 没有用于编辑参数描述的内置界面,因此需要 VBA。很难找到相关文档。
关于注册用户定义函数的代码和信息 -:
创建功能区按钮以列出 VBA 程序
我还没有尝试过这个,但我可以看到它非常方便,特别是因为它很容易进一步定制,也许还有项目特定的函数列表和其他信息。
可以将一个按钮添加到功能区,单击该按钮会显示 VBA procedures/functions 的列表,使用 XML 和 VBA 显示用户表单一个按钮。还有一个选项可以将程序列表保存到文本文件。
您已经可以通过“开发人员”选项卡上的“宏”按钮查看工作簿中的过程。但是,只有模块中和工作表中的无参数子例程才会显示在“宏”对话框中。带有参数的函数和子例程不会显示。本专栏中描述的代码显示了工作簿中的所有子例程和函数。
更多信息和完整代码可用here.
VBA写VBA代码的代码!?
通过以编程方式操作 VBA 编辑器 (VBE),您可以在 VBA 中编写代码来读取或修改其他 VBA 项目、模块和过程,并可用于自动执行与开发相关的任务。这叫做 extensibility 因为它扩展了 editor -- 你可以使用 VBA 代码创建新的 VBA 代码。您可以使用这些功能来编写创建、更改或删除 VBA 模块和代码过程的自定义过程。
令人惊叹的 Chip Pearson 再次做到了,此处 提供了详细的说明和完整的代码,了解可扩展性可以为您做的一些有趣的事情。
Chip页面部分代码列表(here):
- Add/Delete/Rename 项目中的模块
- Add/Delete/Rename 模块中的过程
- 在项目之间复制模块
- 在代码模块中创建新过程
- 创建事件过程
- 列出模块中的所有过程
- 阅读程序声明
- 在模块中搜索文本
- 修复 VBE 中的屏幕闪烁问题
- 将 VBComponent 导出到文本文件
- 测试 VBComponent 是否存在
- 确定与 VBProject 关联的工作簿
- 计算 Module/Project/Component 中的代码行数
这些方法使用 VBA Extensibility [library] (http://www.exceltoolset.com/setting-a-reference-to-the-vba-extensibility-library-by-code/)(参考)并要求以编程方式访问 VBA 项目,这是 Excel 选项中的一项安全设置。有关详细信息,请参阅 Chip 的页面。
Chip 的页面在 Customizing Menus with VBA 上也提供了很好的信息和代码,这可能有助于使开发人员 自己的 工作更轻松。
看似"forgotten" VBA 的能力,如果 控制 甚至 拦截 内置命令。这也可以使开发人员受益(尤其是记忆力不佳的开发人员!)...来自 Microsoft here.
的更多信息和示例通过相似度搜索别名
A) 简介
Your Comment as of 1/22: "The issue is not that I necessarily want to call out the alias intentionally, it's an issue of forgetting what I may have named a function to begin with (ie.
verifyRange
vsverifyRng
). If I knew I was calling the alias name to begin with then I wouldn't need to call the alias. But your solution does work and it was very well thought out."
由于您在上面引用的评论中的示例:当您 稍微修改了您的初始问题 时,我想到了一个替代解决方案并将其添加为一个独立的 new回答:
► You could take some advantage of using a so called
SoundEx
search to group procedure names based on a phonetic algorithm.
方法:一个Soundex代码识别一组发音相似的术语、名称或... ►过程名称。如果您将此与通过所有现有 procedures/functions 的 VBIDE 列表的循环相结合(不要忘记设置引用 ),您能够列出最有可能的别名。
Example result
1/1 Project(s): "VBAProject" (D:\Excel\test.xlsm)
**Project name: "VBAProject" ** (Host Project)
++SoundEx("verifyRange")="V616"
-- Found -- Procedure/Function name(s) --------- ------------------
[Prc: Sub] verifyRng in Std Module modTest1 Line#: 2/[Body: 3]
[Prc: Sub] verifyRange in Std Module modSortDict Line#: 6/[Body: 6]
注意:此方法基于六种语音分类构建压缩字母数字代码 人类语音(双唇、唇齿音、牙音、牙槽音、软腭音和声门音),去除人声和 'H'、'W' 和 [=128] 的一些出现=];该代码由第一个大写字母和后面的三个数字组成(如果找不到更多辅音,则用 0
填充)。顺便说一句,起源可以追溯到 1800 年代后期,用于 索引美国人口普查记录 。
链接
Find the word which I closest to the particular string? http://www.creativyst.com/Doc/Articles/SoundEx1/SoundEx1.htm#JavaScriptCode https://en.wikipedia.org/wiki/Soundex
Soundex 示例
为了演示 soundex 编码,请尝试以下具有相同结果的示例调用:
Sub testSoundEx()
Dim i As Integer
Dim a()
a = Array("verifyRange", "verifyRng", "vrfRanges")
Debug.Print "Proc name", "SoundEx Code": Debug.Print String(50, "-")
For i = LBound(a) To UBound(a)
Debug.Print a(i), SoundEx(a(i))
Next i
End Sub
SoundEx函数
Function SoundEx(ByVal s As String) As String
' Site:
' Source: Developed by Richard J. Yanco
' Method: follows the Soundex rules given at http://home.utah-inter.net/kinsearch/Soundex.html
Dim Result As String, c As String * 1
Dim Location As Integer
s = UCase(s) ' use upper case
' First character must be a letter
If Len(Trim(s)) = 0 Then
Exit Function
ElseIf Asc(Left(s, 1)) < 65 Or Asc(Left(s, 1)) > 90 Then
SoundEx = ""
Exit Function
Else
' (1) Convert to Soundex: letters to their appropriate digit,
' A,E,I,O,U,Y ("slash letters") to slashes
' H,W, and everything else to zero-length string
Result = Left(s, 1)
For Location = 2 To Len(s)
Result = Result & Category(Mid(s, Location, 1))
Next Location
' (2) Remove double letters
Location = 2
Do While Location < Len(Result)
If Mid(Result, Location, 1) = Mid(Result, Location + 1, 1) Then
Result = Left(Result, Location) & Mid(Result, Location + 2)
Else
Location = Location + 1
End If
Loop
' (3) If category of 1st letter equals 2nd character, remove 2nd character
If Category(Left(Result, 1)) = Mid(Result, 2, 1) Then
Result = Left(Result, 1) & Mid(Result, 3)
End If
' (4) Remove slashes
For Location = 2 To Len(Result)
If Mid(Result, Location, 1) = "/" Then
Result = Left(Result, Location - 1) & Mid(Result, Location + 1)
End If
Next
' (5) Trim or pad with zeroes as necessary
Select Case Len(Result)
Case 4
SoundEx = Result
Case Is < 4
SoundEx = Result & String(4 - Len(Result), "0")
Case Is > 4
SoundEx = Left(Result, 4)
End Select
End If
End Function
SoundEx()
调用的辅助函数这个辅助函数 return 是一个基于语音分类的字母代码(见上面的注释):
Private Function Category(c) As String
' Returns a Soundex code for a letter
Select Case True
Case c Like "[AEIOUY]"
Category = "/"
Case c Like "[BPFV]"
Category = "1"
Case c Like "[CSKGJQXZ]"
Category = "2"
Case c Like "[DT]"
Category = "3"
Case c = "L"
Category = "4"
Case c Like "[MN]"
Category = "5"
Case c = "R"
Category = "6"
Case Else 'This includes H and W, spaces, punctuation, etc.
Category = ""
End Select
End Function
► Solution to your issue - Example Call to get Functions by Alias
B) 内存问题或如何记忆
您可以使用以下示例调用通过语法 listProc {function name string}
搜索 procedure/function 别名,例如listProc "verifyRange"
并且您会在 Visual Basic 编辑器 (VBE) 的 即时 Window 中得到所有找到的别名 的压缩列表 ):
Sub Test()
listProc "verifyRange" ' possibly gets verifyRange AND verifyRng via SoundEx "V616"
'listProc "verify" ' possibly gets nothing, as SoundEx "V610" has no fourth consonant
'listProc '[ displays ALL procedures without SoundEx Filter ]
End Sub
注意: 请记住 SoundEx 代码(例如 "V616" 代表 verifyRange
)的长度限制为四个字母数字人物。
如果您只查找 "verify"(= 3 个辅音 V+r+f),您会得到 "V610" 而不是 "verifyRange" 或 "verifyRng"(V+r+ f+r)。
在这种情况下,您应该搜索一对变体。
=============================
主程序listProc
=====================
Sub listProc(Optional ByVal sFuncName As String)
' Purpose: display procedures using a SoundEx Filter
' Call: 0 arguments or empty argument - ALL procedures without filter
' 1 argument (not empty) - procedures found via SoundEx
' Note: requires reference to Microsoft Visual Basic for Applications Extensibility 5.3
' Declare variables to access the macros in the workbook.
Dim VBAEditor As VBIDE.VBE ' VBE
Dim objProject As VBIDE.VBProject ' Projekt
Dim objComponent As VBIDE.VBComponent ' Modul
Dim objCode As VBIDE.CodeModule ' Codeblock des Moduls
' Declare other miscellaneous variables.
Dim sProcName As String
Dim sndx As String, sndx2 As String
Dim pk As vbext_ProcKind ' proc kind (Sub, Function, Get, Let)
Dim strPK As String, sTyp As String
Dim iLine As Integer, iBodyLine As Integer, iStartLine As Integer
Dim i As Integer
Dim bShow As Boolean ' show procedure name
Dim bSoundEx As Boolean
If Len(Trim(sFuncName)) > 0 Then bSoundEx = True ' show alle procedures!
' ========================================
' Get the project details in the workbook.
' ========================================
Set VBAEditor = Application.VBE
Set objProject = VBAEditor.ActiveVBProject
' Set objProject = VBAEditor.VBProjects("MyProcject") ' 1-based, project name or item number
For i = 1 To VBAEditor.VBProjects.Count ' show name, filename, buildfilename (DLL)
Debug.Print i & "/" & _
VBAEditor.VBProjects.Count & " Project(s): """ & _
VBAEditor.VBProjects(i).Name & """ (" & VBAEditor.VBProjects(i).filename & ")"
Next i
' get SoundEx of Function name
sndx2 = SoundEx(sFuncName)
' ==================
' ? PROJECT NAME
' ==================
' objProject.Type ...vbext_pt_HostProject 100 Host-Project
' ...vbext_pt_StandAlone 101 Standalone-Project
Debug.Print "**Project name: """ & objProject.Name & """ ** (" & _
IIf(objProject.Type = 100, "Host Project", "Standalone") & ")"
If bSoundEx Then Debug.Print "++SoundEx(""" & sFuncName & """)=""" & sndx2 & """" & _
vbNewLine & "-- Found -- Procedure/Function name(s)"
' Iterate through each component (= Module) in the project.
For Each objComponent In objProject.VBComponents ' alle MODULE
' Find the code module for the project (Codeblock in current component/=module).
Set objCode = objComponent.CodeModule
' =============
' ? MODULE NAME
' =============
If objCode.CountOfLines > 0 And Not bSoundEx Then
Debug.Print " *** " & _
sModType(objComponent.Type) & " ** " & objComponent.Name & " ** "
End If
' Scan through the code module, looking for procedures.
' Durch alle Codezeilen des jeweiligen Moduls gehen
iLine = 1
Do While iLine < objCode.CountOfLines ' alle Zeilen durchackern (1/End ...)
' =================
' Get Procedurename ' !! SETZT AUTOMATISCH >> pk << !!
' =================
sProcName = objCode.ProcOfLine(iLine, pk) ' jede nächste Zeile auf Prozedurbeginn checken
If sProcName <> "" Then ' ohne Declaration head
' -----------------
' Found a procedure
' -----------------
' a) Get its details, and ...
strPK = pk ' 0-Prc|1-Let/2-Set/3-Get Werte abfangen !!!
'' iStartLine = objCode.ProcStartLine(sProcName, strPK) ' here = iLine !!
iBodyLine = objCode.ProcBodyLine(sProcName, strPK) ' Zeilennr mit Sub/Function/L/S/Get
sTyp = sPrcType(objCode.Lines(iBodyLine, 1)) ' Sub|Fct|Prp
' b) Check Soundex
If bSoundEx Then
sndx = SoundEx(sProcName)
If sndx = sndx2 Or UCase(sProcName) = UCase(sFuncName) Then
bShow = True
Else
bShow = False
End If
Else
bShow = True
End If
' ==============
' c) ? PROC NAME
' --------------
If bShow Then
Debug.Print " " & "[" & sPK(strPK) & ": " & sTyp & "] " & _
sProcName & IIf(bSoundEx, " in " & sModType(objComponent.Type) & " " & objComponent.Name, "") & vbTab, _
"Line#: " & iLine & "/[Body: " & iBodyLine & "]"
End If
' -------------------------------------------
' d) Skip to the end of the procedure !
' => Add line count to current line number
' -------------------------------------------
iLine = iLine + objCode.ProcCountLines(sProcName, pk)
Else
' This line has no procedure, so => go to the next line.
iLine = iLine + 1
End If
Loop
Next objComponent
' Clean up and exit.
Set objCode = Nothing
Set objComponent = Nothing
Set objProject = Nothing
End Sub
3 主程序的辅助函数 listProc
这些辅助函数 return 过程和模块的附加信息:
Function sPK(ByVal prockind As Long) As String
' Purpose: returns short description of procedure kind (cf ProcOfLine arguments)
Dim a(): a = Array("Prc", "Let", "Set", "Get")
sPK = a(prockind)
End Function
Function sPrcType(ByVal sLine As String) As String
' Purpose: returns procedure type abbreviation
If InStr(sLine, "Sub ") > 0 Then
sPrcType = "Sub" ' sub
ElseIf InStr(sLine, "Function ") > 0 Then
sPrcType = "Fct" ' function
Else
sPrcType = "Prp" ' property (Let/Set/Get)
End If
End Function
Function sModType(ByVal moduletype As Integer) As String
' Purpose: returns abbreviated module type description
Select Case moduletype
Case 100
sModType = "Tab Module"
Case 1
sModType = "Std Module"
Case 2
sModType = "CLS Module"
Case 3
sModType = "Frm Module"
Case Else
sModType = "?"
End Select
End Function