将excel公式转换为VBA宏

Question

我在 excel 中有一个表格，其中有一个查找列用于我们所有的内部拨号代码定义。 （这些在 F 和 G 列中）- 然后，我有一个查找列，我们希望在其中匹配客户的拨号代码以找到最接近的匹配项。 该公式现在通过检查是否存在匹配来对一系列列执行此操作，如果没有，则删除最后一个数字，然后再次比较

然后我将它们与我给出的定义进行比较

通过一次删除 1 个号码 - 我最终会在代码上找到匹配项 how the sheet parses to get the match table of dial-code matches

我现在将它放在一个 excel 公式中，但想让它成为我可以调用的 VBA 函数，以便它运行得更快 - 它需要将所有列 F 和 G 比较为按数字顺序排序的匹配项

=IF($A3="","",IF(AND(F3="", CONCATENATE(C3,D3, E3,F3) = ""), IF(ISNA(VLOOKUP(LEFT($B3,MAX(0, LEN($B3) - G$1))+0,Input!$F:$G,1,FALSE))=FALSE,
VLOOKUP(LEFT($B3,MAX(0, LEN($B3) - G$1))+0,Input!$F:$G,2,FALSE),""),""))

Answer 1

试试

Option Explicit

Sub LocateCode()

    Dim wb As Workbook, ws As Worksheet, wsInput As Worksheet
    Dim rngInput As Range, found As Range
    Dim LastRow As Long, LastInput As Long, r As Long
    Dim code As String, n As Integer
    
    Set wb = ThisWorkbook
   
    ' look up range
    Set wsInput = wb.Sheets("Input")
    With wsInput
        LastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
        Set rngInput = .Range("F2:F" & LastRow)
    End With
   
    ' data
    Set ws = wb.Sheets("Input")
    With ws
       LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
       For r = 2 To LastRow
          code = .Cells(r, "B")
          n = Len(code)
          Do
              Set found = rngInput.Find(Left(code, n), Lookat:=xlWhole, LookIn:=xlValues)
              If Not found Is Nothing Then
                  .Cells(r, "C") = found.Offset(0, 1)
                  ' compare
                  If .Cells(r, "A") <> .Cells(r, "C") Then
                      .Cells(r, "A").Interior.Color = vbYellow
                  End If
                  Exit Do
              End If
              n = n - 1
              If n = 0 Then .Cells(r, "C") = "#N/A"
          Loop Until n = 0
       Next
    End With
   
    MsgBox "Done"
End Sub