将单元格值添加到列表

Question

我有一个宏贯穿两个列表，将一列与另一列匹配。然后，它接受这些项目并计算各种数据，然后将结果放在表格数组中，以供用户评估。

根据ID1与ID2的匹配检查上述数据。结果数组如下：

因此，相等的匹配是每个列表中都有两个匹配且实例数量相等（完美）的实例。不相等的匹配项意味着存在匹配项，但是一个匹配项可能比另一个匹配项出现在列表中的次数更多。下一列说明list1 vs list2中有多少个。你希望我能想到。

这很好用，但是现在用户要求我也将Last1和Last2拉到表中。因此，它们将具有与ID相关联的姓氏。以下是运行匹配并创建列表的代码部分。我在将这些单元格添加到列表时遇到了麻烦。通常我会使用offset方法，但是我无法弄清楚这一点。希望有人比我聪明有一个主意。

在“选择大小写”部分中，该代码告诉代码将表数组的结果放在何处。

谢谢，请帮忙！

Dim rng As Range, Dn As Range, n As Long
Dim oVal As Variant, CC As Long, ccc As Long, cccc As Long
Dim Q As Variant, K As Variant, c As Long, rng1 As Range
Dim List1 As Long, List2 As Long, oMax As Long
Set rng = Range(Range("C2"), Range("C" & Rows.Count).End(xlUp))
Set rng1 = Range(Range("H2"), Range("H" & Rows.Count).End(xlUp))
    Range("j:m").Clear
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
 oVal = Array(rng, rng1)
For n = 0 To 1
    For Each Dn In oVal(n)
        List1 = 0: List2 = 0
        If Not .Exists(Dn.Value) Then
            If n = 0 Then List1 = 1 Else List2 = 1
            .Add Dn.Value, Array(List1, List2)
        Else
            Q = .Item(Dn.Value)
                If n = 0 Then Q(0) = Q(0) + 1 Else Q(1) = Q(1) + 1
            .Item(Dn.Value) = Q
        End If
Next Dn
Next n
c = 1: CC = 1: ccc = 1: cccc = 1
For Each K In .keys
    Select Case True
        Case .Item(K)(0) = .Item(K)(1)
            c = c + 1
         Cells(c, "J") = K
         Cells(c, "K") = .Item(K)(O)
        Case .Item(K)(0) = 0
            ccc = ccc + 1
            Cells(ccc, "N") = K
            Cells(ccc, "O") = .Item(K)(1)
        Case .Item(K)(1) = 0
            cccc = cccc + 1
            Cells(cccc, "P") = K
            Cells(cccc, "Q") = .Item(K)(0)
        Case .Item(K)(0) <> .Item(K)(1)
            CC = CC + 1
            Cells(CC, "L") = K
            Cells(CC, "M") = .Item(K)(0) & ", " & .Item(K)(1)
    End Select
Next K
End With
oMax = Application.Max(c, CC, ccc, cccc)