excel - 跨excel文件显示交集值

Question

我有大约 8000 行的表。

这只是一个例子：

我需要显示跨列 Co 的交集值。例如，我需要显示这样的结果：

描述结果。它查看表格并显示有多少 No 列共享同一个 Co。例如：Co 列中的值 12 与 9 有一个数字同时具有 12 和 9。12 本身显示 3 因为有： 456 ,457 ，并且 458 的值为 12 。以此类推与其他值。我尝试使用数据透视表，但它对我没有帮助，因为它同时使用一列（它不允许我生成具有我想要的结果的表）。我试图使用 PowerBi，但它也无济于事。任何人都可以帮忙吗？谢谢

Answer 1

将数据放在Sheet1上，结果转到Sheet2。

Option Explicit

Sub macro()

    Dim i As Long, j As Long, n As Long
    Dim sCo As String, sNo As String
    Dim dictNo As Object, dictCo As Object, key
    Dim ar() As Long, arNo As Variant
    Set dictNo = CreateObject("Scripting.Dictionary")
    Set dictCo = CreateObject("Scripting.Dictionary")

    n = 0
    For i = 2 To 10
       sCo = CStr(Sheet1.Cells(i, 2))
       sNo = CStr(Sheet1.Cells(i, 3))
       ' axis
       If Not dictCo.exists(sCo) Then
           dictCo(sCo) = n
           n = n + 1
       End If

       ' intersects
       If dictNo.exists(sNo) Then
           dictNo(sNo) = dictNo(sNo) & "," & sCo
       Else
           dictNo(sNo) = sCo
       End If
    Next
   
    ' size the count array and fill in the axis
    ' top row and end column
    n = dictCo.Count
    ReDim ar(n + 1, n + 1)
    i = 0
    For Each key In dictCo
        ar(0, i) = key
        ar(i + 1, n) = key
        i = i + 1
    Next

    ' calc counts
    Dim x As Long, y As Long
    For Each key In dictNo
        arNo = Split(dictNo(key), ",")
        For i = 0 To UBound(arNo)
            x = CLng(dictCo(arNo(i)))
            For j = 0 To UBound(arNo)
                y = CLng(dictCo(arNo(j)))
                ar(x + 1, y) = ar(x + 1, y) + 1
            Next
        Next
    Next

    ' result
    Dim rng As Range
    Set rng = Sheet2.Range("A1").Resize(n + 1, n + 1)
    rng.Value2 = ar
    rng.Font.Bold = True
    With rng.Borders
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
   
    ' sort table rows
    Set rng = Sheet2.Columns(n + 1)
    With Sheet2.Sort
        .SortFields.Clear
        .SortFields.Add key:=rng, _
           SortOn:=xlSortOnValues, Order:=xlAscending, _
           DataOption:=xlSortNormal
        .SetRange Sheet2.Range("A2").Resize(n, n + 1)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    ' sort table columns
    Set rng = Sheet2.Cells(1, 1).Resize(1, n + 1)
    With Sheet2.Sort
        .SortFields.Clear
        .SortFields.Add key:=rng, _
           SortOn:=xlSortOnValues, Order:=xlDescending, _
           DataOption:=xlSortNormal
        .SetRange Sheet2.Range("A1").Resize(n + 1, n + 1)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With
    ' color
    rng.Interior.Color = RGB(220, 220, 255)
    Sheet2.Cells(1, n + 1).Resize(n + 1, 1).Interior.Color = RGB(220, 220, 255)
    Sheet2.Range("A1").Offset(0, n) = "Co"
    
    MsgBox "Done"

End Sub