通过项目分割的vlookup不起作用

Question

有一次，我问过像vlookup这样的函数，但是对于分割值。我用了很长时间。现在，代码似乎不再起作用。 什么原因使代码不再起作用？

Sub test()
Dim Cl As Range, Key As Variant
Dim Dic As Object: Set Dic = CreateObject("Scripting.Dictionary")
Dic.CompareMode = vbTextCompare
With Sheets("Sheet1")
    For Each Cl In .Range("A1:A" & .Cells.SpecialCells(xlCellTypeLastCell).Row)
        If Cl.Value <> "" Then
            Dic.Add Cl.Row & "|" & Replace(LCase(Cl.Value), ";", "||") & "|", Cl.Offset(, 1).Text
        End If
    Next Cl
End With
With Sheets("Sheet2")
    For Each Cl In .Range("A1:A" & .Cells.SpecialCells(xlCellTypeLastCell).Row)
        For Each Key In Dic
            If Key Like "*|" & LCase(Cl.Value) & "|*" And Cl.Value <> "" Then
                Cl.Offset(, 1).Value = Dic(Key)
                Exit For
            End If
        Next Key
    Next Cl
End With
End Sub

目前没有错误，但代码无效。对某些人来说，这是有效的。对我而言。 请参阅下面的预期结果：

Answer 1

我觉得有必要重构你的代码，因为我刚刚发布了一个关于如何做Wildcard search of dictionary的答案。

你能编辑你的答案，以包括Sheet1和A的A列的样本数据。 Sheet2的？

Sub RefactoredCode()

    Dim Cl As Range
    Dim key, keys, results
    Dim MatchString As String

    Dim dic As Object: Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = vbTextCompare

    With Sheets("Sheet1")
        For Each Cl In .Range("A1", .Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)

            dic.Add Cl.Row & "|" & Replace(LCase(Cl.Value), ";", "||") & "|", Cl.Offset(, 1).Text

        Next Cl
    End With

    keys = dic.keys

    With Sheets("Sheet2")
        For Each Cl In .Range("A1", .Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)

        MatchString = "|" & LCase(Cl.Value) & "|"
            results = Filter(keys, MatchString, True, vbTextCompare)

            If UBound(results) > -1 Then
                key = results(0)
                Cl.Offset(, 1).Value = dic(key)
            End If

        Next Cl
    End With

End Sub

我同时运行了RefactoredCode()和Test()。他们两个都正常工作。