將excel公式轉換為VBA宏

Question

我在 excel 中有一個工作表，其中有一個用於我們所有內部撥號代碼定義的查找列。 （這些在 F & G 列中） - 然后我有一個查找列，我們希望在其中匹配來自客戶的撥號代碼以找到最接近的匹配項。 該公式現在通過檢查是否存在匹配來對一系列列執行此操作，如果不匹配，則刪除最后一個數字，然后再次進行比較

然后我將它們與我給出的定義進行比較

並且通過一次刪除 1 個號碼 - 我最終得到了代碼匹配表如何解析以獲得撥號代碼匹配的匹配表

我現在在一個 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