Question

在以下数据中，我想使用 L 列和 M 列来配对 A ，之间的匹配B 和 C ， D 。

Sample Picture

更准确地说，我希望Serial Number A： 10 - SUV 匹配Serial Number: B 10 - Car 。如果这些组合中的任何一个不匹配，我应该得到一个红旗。例如，Serial Number A： 40 ，不能取值“轿车”。根据列 L 和 M <中的对值，它必须是“ Road Bike ”或“ Mountain Bike ” / strong>，分别。

我认为双重匹配会起作用，但是，我不确定如何解决这个问题。

提前谢谢！

Answer 1

我有机会调试我编写的代码示例，所以这是工作产品。

我认为你需要的是为每个选择建立一个合适的响应数组，使用类似的东西：

Function GetKeys() As Variant
    'This function will obtain an array of suitable response keys that can be used to then check the values.
    Dim TmpArr As Variant
    Dim Sht As Worksheet
    Set Sht = Worksheets("[SheetName]") 'Replace [SheetName] with your actual sheer name.
    TmpArr = Sht.Range("L2:M" & Sht.Range("L" & Sht.Rows.Count).End(xlUp).Row).Value
    TmpArr = Application.WorksheetFunction.Transpose(TmpArr)
    Dim Arr() As String
    ReDim Arr(1 To 2, 1 To 1) As String
    Dim NoKeys As Integer, X As Integer, Y As Integer
    'This will fill the first dimension of the array with the unique values from Column M
    Arr(1, 1) = LCase(CStr(TmpArr(2, 1)))
    For X = 2 To UBound(TmpArr, 2)
        For Y = 1 To UBound(Arr, 2)
            If LCase(CStr(TmpArr(2, X))) = Arr(1, Y) Then GoTo ExistsAlready
        Next Y
        ReDim Preserve Arr(1 To 2, 1 To (UBound(Arr, 2) + 1))
        Arr(1, UBound(Arr, 2)) = LCase(CStr(TmpArr(2, X)))
ExistsAlready:
    Next X
    'This now fills the second dimension of the array with a comma separated list of suitable values from Column L
    For X = 1 To UBound(TmpArr, 2)
        For Y = 1 To UBound(Arr, 2)
            If LCase(CStr(TmpArr(2, X))) = Arr(1, Y) Then
                    If Arr(2, Y) = "" Then
                            Arr(2, Y) = LCase(CStr(TmpArr(1, X)))
                        Else
                            Arr(2, Y) = Arr(2, Y) & ", " & LCase(TmpArr(1, X))
                    End If
                    Exit For
            End If
        Next Y
    Next X
    GetKeys = Arr
End Function

然后，一旦有了这个，就可以使用类似的东西检查该数组的值列表：

Sub CheckValues()
    Dim Sht As Worksheet
    Dim Keys As Variant
    'This calls the above function to obtain the list of suitable keys
    Keys = GetKeys
    Dim Set1 As Variant, Set2 As Variant
    Set Sht = Worksheets("[SheetName]")
    Set1 = Sht.Range("A2:B" & Sht.Range("A" & Sht.Rows.Count).End(xlUp).Row).Value
    Set2 = Sht.Range("C2:D" & Sht.Range("C" & Sht.Rows.Count).End(xlUp).Row).Value
    Set1 = Application.WorksheetFunction.Transpose(Set1)
    Set2 = Application.WorksheetFunction.Transpose(Set2)
    Dim X As Integer, Y As Integer, Z As Integer
    'This starts by looping through each row of data in Columns C:D and finds the corresponding key value from Column M
    For X = 1 To UBound(Set2, 2)
        For Y = 1 To UBound(Keys, 2)
            If LCase(CStr(Set2(2, X))) = CStr(Keys(1, Y)) Then
                    'Having Found the key from Column C:D, it now finds the value in Column A that matches C
                    For Z = 1 To UBound(Set1, 2)
                        'This checks whether the value in B is one of the suitable values from Column L and colours the cells if not
                        If Set2(1, X) = Set1(1, Z) Then
                                If Keys(2, Y) Like "*" & LCase(CStr(Set1(2, Z))) & "*" Then
                                        GoTo Found_It
                                    Else
                                        Sht.Range("A" & (Z + 1) & ":B" & (Z + 1)).Interior.ColorIndex = 46
                                        Sht.Range("C" & (X + 1) & ":D" & (X + 1)).Interior.ColorIndex = 46
                                        GoTo Found_It
                                 End If
                        End If
                    Next Z
            End If
        Next Y
Found_It:
    Next X
End Sub

Excel索引匹配 - 配对对应于范围

1 个答案: