将excel公式转换为VBA宏

Question

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

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

通过每次删除一个数字-我最终得到一个匹配的代码表如何解析以获得匹配拨号码匹配表

我现在有一个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

Try

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