将Excel dial-code匹配公式转换为可调用VBA宏函数的咨询

功能说明 #

完全对齐你原有公式的匹配逻辑：输入客户提供的dialcode，优先全量匹配内部编码，无匹配则逐位删除号码末尾字符重新匹配，直到找到对应编码后返回G列的映射值，无匹配返回空值，适配你已排序的F/G列查找范围，运行效率远高于多列排布的数组公式。

使用步骤 #

• 按Alt+F11打开VBA编辑器，右键点击你的工作簿名称，选择「插入」-「模块」
• 将下方代码粘贴到模块窗口中，保存工作簿为.xlsm格式即可
• 回到工作表后直接调用函数，例如要匹配B列的客户dialcode，单元格公式写=匹配DialCode(B3)即可

完整代码 #

Function 匹配DialCode(待匹配号码 As Variant) As String
    ' 定义变量
    Dim 查找工作表 As Worksheet
    Dim 编码列 As Range
    Dim 号码长度 As Integer
    Dim 当前截取长度 As Integer
    Dim 查找值 As Double
    Dim 匹配位置 As Variant
    
    ' 初始化查找范围，此处默认内部编码在Input工作表的F、G列，可按需修改
    Set 查找工作表 = ThisWorkbook.Worksheets("Input")
    Set 编码列 = 查找工作表.Range("F:F")
    
    ' 处理空输入
    If IsEmpty(待匹配号码) Or CStr(待匹配号码) = "" Then
        匹配DialCode = ""
        Exit Function
    End If
    
    待匹配号码 = CStr(待匹配号码)
    号码长度 = Len(待匹配号码)
    
    ' 从最长位数开始逐位截断匹配
    For 当前截取长度 = 号码长度 To 1 Step -1
        On Error Resume Next
        查找值 = CDbl(Left(待匹配号码, 当前截取长度))
        If Err.Number <> 0 Then
            Err.Clear
            GoTo 下一轮截取
        End If
        On Error GoTo 0
        
        ' 利用F列已排序的特性查找，速度更快
        匹配位置 = Application.Match(查找值, 编码列, 0)
        If Not IsError(匹配位置) Then
            ' 找到匹配返回对应G列的值
            匹配DialCode = 查找工作表.Cells(匹配位置, "G").Value
            Exit Function
        End If
下一轮截取:
    Next 当前截取长度
    
    ' 全程无匹配返回空
    匹配DialCode = ""
End Function

自定义调整说明 #

• 如果你的内部编码工作表名称不是Input，修改代码中ThisWorkbook.Worksheets("Input")里的工作表名称即可
• 如果编码列和映射值列不是F、G列，对应修改Range("F:F")和Cells(匹配位置, "G")里的列标识即可
• 如果需要兼容原公式中A列为空就返回空的判断，调用公式时写成=IF(A3="","",匹配DialCode(B3))即可

内容的提问来源于stack exchange，提问作者Aaron Hyman