是否可以将别名分配给一个函数？

Question

我正在编写一个简单的函数，例如：

Function myFunction() As Variant
    'Some rules
End Function

对于上述函数，是否可以像使用API调用那样分配别名？

显然，这不是正确的语法，但您有这样的想法：

Function myFunction() Alias myFunc As Variant
    'Some rules
End Function

这将允许我使用任何一个名称：

Sub Test()
    Debug.Print myFunction
    Debug.Print myFunc
End Sub

Answer 1

简单VBA示例(没有类)

当您称自己为TheNotSoGuru时，尝试以下相对简单的方法:而不是像alias定义那样的API，您必须在一个用户定义的别名()函数中编写别名定义。

调用测试过程

这向您展示了如何使用ONE用户定义的alias函数调用别名；第一个参数是您的别名string，其他参数定义了原始函数本身的可能参数：

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

别名()函数的=============== 示例

您负责将别名定义插入别名函数中。它甚至允许您通过提出450错误“错误的参数数.”来强制输入正确的参数数。通过错误处理。如果发生错误，则消息框将显示错误消息。

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

Answer 2

基于相似度的别名搜索

A.介绍

您在1/22时的评论：：“问题不在于我一定要故意调用别名，而是忘了我可能一开始就命名了一个函数(即verifyRange vs verifyRng)。如果我知道我一开始就叫别名，那么我就不需要调用别名了。但是您的解决方案确实有效，而且经过了很好的考虑。”

由于您在上面引用的注释中的例子:当您稍微修改了您最初的问题时，我考虑了另一种解决方案，并将其添加为独立的新答案：

您可以利用所谓的SoundEx search对基于语音算法的过程名称进行分组。

方法：A Soundex代码标识一组类似的发音术语、名称或.►过程名称。如果将此与通过VBIDE列表中的所有现有过程/函数(别忘了设置引用)循环结合，则可以获得最有可能列出的别名(Es)。

示例结果

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”和“Y顺便说一句，起源可以追溯到1800年末，用来编制美国人口普查记录的索引。

链接

找到我最接近特定字符串的单词吗？ 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:   https://stackoverflow.com/questions/19237795/find-the-word-which-i-closest-to-the-particular-string/19239560#19239560
' 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()调用

这个辅助函数返回一个基于语音分类的字母代码(见上面的注释)：

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

►解决方案--通过别名调用获取函数的示例

B)内存问题或如何慢跑记忆

您可以使用下面的示例调用通过语法listProc {function name string}搜索过程/函数别名，例如，listProc "verifyRange"并在Visual编辑器的立即窗口中获得所有找到的别名的浓缩列表：

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)限制为四个字母数字字符的长度。如果您只查找“验证”(= 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

到主程序listProc的3帮助函数

这些辅助函数将其他信息返回给过程和模块：

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