Excel VBA*通配符*Vlookup-或替代

我希望使用Vlookup函数编写一段代码，将值返回到相邻列。但是，我希望查找与通配符一起工作，即不需要精确匹配

下面的代码将逐行向下查看D列，然后使用该值从数据表中查找相应的值，并将其返回到E列。这种方法很有效，但无法很好地处理缺失或不正确的值

D列中的数据将是全文格式的句子，所以我只需要查找关键字，然后返回一个设置的参考值进行数据处理

    Sub LookUpComments() 'exact match only ???

On Error Resume Next
Application.ScreenUpdating = False

    Dim DataRow As Long
    Dim DataClm As Long
    Dim Result As Variant

DataTable = Sheet3.Range("D5:D35")
LookUpTable = Sheet3.Range("AA10:AB20")
Sheet3.Range("E5:E10000").ClearContents

DataRow = Sheet3.Range("E5").Row
DataClm = Sheet3.Range("E5").Column

For Each cl In DataTable

        If cl = "" Then GoTo E
        Result = Application.WorksheetFunction.VLookup(cl, LookUpTable, 2, blnLookupType)
        If Result = Error Then GoTo E
        Sheet3.Cells(DataRow, DataClm) = Result

E:            DataRow = DataRow + 1
Next cl

Application.ScreenUpdating = True
MsgBox "Data LookUp is complete"

End Sub

我希望我已经说得够清楚了？如果这个函数不可能，你认为我可以使用某种循环查找和替换函数吗

---

提前感谢

如果像使用blnLookupType设置为true那样使用Vlookup无法得到所需的结果，则可以使用Range.Find，然后使用Offset返回所需的值。它支持通配符，您可以搜索字符串的一部分或整个字符串。见下面的例子

Sub FindingPart()

Dim rng As Range, found As Range
Set rng = Sheet2.Range("A:A")

Set found = rng.Find(What:="as", LookAt:=xlPart) 'Will find for example "bass"
If Not found Is Nothing Then returnValue = found.Offset(0, 1)

End Sub



Sub FindingWildCards()

Dim rng As Range, found As Range
Set rng = Sheet2.Range("A:A")

Set found = rng.Find(What:="as*", LookAt:=xlWhole) 'Would find for example "ashes" but not "bass"
If Not found Is Nothing Then returnValue = found.Offset(0, 1)

End Sub

---

谢谢你的建议，看来我和VLookup走错了路

我现在已经编写了一个代码，它可以完美地满足我的需要，尽管我相信它可以写得更好。我使用vlookup为每个搜索条件获取一个返回值，然后为每个搜索条件循环一个find/replace

Sub FilterComments()

On Error Resume Next

Dim Rng As Range, found As Range
Dim Rtn As String

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

    LookUpValue = ActiveWorkbook.Sheets("LOOKUP").Range("I10:I108")
    LookUpTable = ActiveWorkbook.Sheets("LOOKUP").Range("I10:J108")

ActiveWorkbook.Sheets("IEOutput").Range("W:W").Value = ActiveWorkbook.Sheets("IEOutput").Range("T:T").Value
ActiveWorkbook.Sheets("IEOutput").Range("W1").Value = "LOOKUP COMMENT"

Set Rng = ActiveWorkbook.Sheets("IEOutput").Range("W:W")

        For Each cl In LookUpValue
        If cl = "" Then GoTo E

            Rtn = Application.VLookup(cl, LookUpTable, 2, False)


            Rng.Replace What:="*" & cl & "*", Replacement:=Rtn, LookAt:=xlPart, _
                SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
                ReplaceFormat:=False
E:
        Next cl


Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Data LookUp is complete", vbInformation, "GM PMS Data Filter"

End Sub

希望这能帮助其他尝试做类似事情的人