Matching similar in Excel VBA

时间:2017-04-10 02:31:58

标签: excel vba excel-vba

I have been trying to find the similar matches to fill the blank Sapcode field in the first screenshot.

The Card Type field in the second screenshot below contains related words to the Card Type column in the first screenshot. E.g. card type and city. The data in the second screenshot also contains the Sapcode for those words.

I would like to find the Sapcode for Card Type values in the first screenshot by matching on the words in the other Card Type column in the second screenshot. Sheet with missing Sapcodes:

Input file i want to fill the sapcode

Sheet with matching rules:

Rule Book Sheet

For example - for the input text visa/20160927/ET-Chennai/FT I can match SAP008 by matching visa and Chennai.

Here is my code so far:

For i = 9 To input_sht.Cells(input_sht.Rows.Count, 1).End(xlUp).Row

input_txt = input_sht.Range("B" & i).Value

For j = 2 To rule_sht.Cells(rule_sht.Rows.Count, 1).End(xlUp).Row

    rulebook_sht = rule_sht.Range("B" & j).Value

    If rulebook_sht <> "" Then

        If InStr(input_txt, rulebook_sht) > 0 Then
         input_sht.Range("C" & i).Value = rule_sht.Range("C" & j).Value
        End If

    End If

Next

Next

The above code works fine if have a field of just visa meaning it will match with visa and give the first searched option but it is not checking the location. How can I update my code to match on all the words?

1 个答案:

答案 0 :(得分:2)

您可以使用带有通配符的Like运算符来比较两个字符串。在这种情况下,您需要使用匹配零个或多个其他字符的*通配符。例如,在VBE立即窗口中输入this并获取True

? "visa/20160927/Chennai/FT" Like "*visa*Chennai*"

因此我们可以使用它来迭代所有输入(第一个屏幕截图中的Card Type)并与所有“规则”(第二个屏幕截图中的Card Type)进行比较。

如果Like运算符给出匹配,您可以获取Sapcode并更新空白列。要创建规则的“通配”版本,您可以使用以下代码:

strWildcardRule = "*" & Join(Split(strRule, " "), "*") & "*"

将“规则”的元素拆分为数组,并使用*为通配符重新加入并包围它们。所以:

visa Chennai

变为:

*visa*Chennai*

然后您可以使用Like运算符。

该代码适用于您提供的测试数据。我已对此进行了评论,因此您可以跟进:

Option Explicit
Option Compare Text

Sub LookupSapcode()

    ' all the required variables
    Dim ws As Worksheet
    Dim rngInput As Range
    Dim rngRules As Range
    Dim rngOutput As Range
    Dim lngInputRow As Long
    Dim lngRuleRow As Long
    Dim strRule As String
    Dim strInput As String
    Dim strOutput As String
    Dim strWildcardRule As String

    ' set references to sheet and ranges to work with
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set rngInput = ws.Range("A2:A10")
    Set rngOutput = ws.Range("B2:B10")
    Set rngRules = ws.Range("D2:E10")

    ' iterate rows
    For lngInputRow = 1 To rngInput.Rows.Count
        ' get card type
        strInput = rngInput.Cells(lngInputRow, 1).Value
        ' iterate rules
        For lngRuleRow = 1 To rngRules.Rows.Count
            ' get the rule as a string
            strRule = rngRules.Cells(lngRuleRow, 1).Value
            ' assume a match on this row of rules and get sap code
            strOutput = rngRules.Cells(lngRuleRow, 2).Value
            ' get the rule as a wildcard string
            strWildcardRule = "*" & Join(Split(strRule, " "), "*") & "*"
            ' if the wildcarded rule is like the input string
            If strInput Like strWildcardRule Then
                ' break the loop as we have a match
                ' strOutput will be the sap code for the matching rule
                Exit For
            Else
                ' no match - set this output to empty string
                strOutput = vbNullString
            End If
        Next lngRuleRow

        ' if output string is not empty then update the row for this card type
        If strOutput <> vbNullString Then
            ' set the sapcode in the output range
            rngOutput.Cells(lngInputRow, 1).Value = strOutput
        End If

    ' next card type in input range
    Next lngInputRow

End Sub

注意我使用Option Compare Text以防有匹配,但Like两侧的大小写不同。查看Like的链接:

  

选项比较文本会根据系统区域设置确定的不区分大小写的文本排序顺序进行字符串比较。使用“选项比较文本”对相同的字符进行排序时,将生成以下文本排序顺序:A = a)&lt; (À=à)&lt; (B = b)&lt; (E = e)&lt; (Ê=ê)&lt; (Z = z)&lt; (直径= O)