Excel: Chuyển đổi hai danh sách thành ma trận

Tôi có hai danh sách trong sổ làm việc của tôi hiện tại

Name | System 1 | System 2 | System 3 |
John |    x     |    x     |          |
James|          |    x     |    x     |
Peter|          |    x     |          |


Name | Process A | Process B | Process C |
John |           |    x      |           |
James|     x     |           |     x     |
Peter|     x     |           |     x     |

Có cách nào tôi có thể làm để hợp nhất hai danh sách này theo định dạng ma trận như dưới đây không?

         |  Process A   |   Process B  |  Process C   |
System 1 |              |     John     |              |
System 2 | James, Peter |     John     | James, Peter |
System 3 |    James     |              |     James    |

Cảm ơn bạn. Đánh giá cao tất cả sự giúp đỡ tôi có thể có.

Các mã đã cho làm những gì bạn muốn. Tôi không mong đợi nó sẽ dài như vậy, xin lỗi vì điều đó. Nhưng tôi nghĩ rằng điều này là khá hiệu quả. Xin lỗi vì không có ý kiến, nhưng tôi vô tình dành nhiều thời gian hơn cho nó mà tôi mong đợi. Vì vậy, đối với bạn điều này có thể khó hiểu mã. Dù sao, câu hỏi được chào đón.

Về cơ bản, bạn được yêu cầu chọn bảng 1, sau đó là bảng thứ 2 (bất kể trong bảng tính nào). Sau đó, mã theo dõi các xgiá trị từ một cột trong bảng đầu tiên và ghi các tên có xtrong cột đó vào một thứ gọi là "từ điển". Sau đó là thời gian cho bảng thứ 2 - nếu có xmột tên bên cạnh, giá trị trong từ điển của tên đó được đổi thành 1. Sau đó, tất cả các tên có giá trị 1trong từ điển được đặt vào strchuỗi và chuỗi này được xuất ra mảng kết quả Array3. Quá trình này lặp lại cho mỗi cột trong cả hai bảng đầu vào. Cuối cùng, mảng kết quả được xuất ra bảng tính mới được tạo.

Alt + F11 mở VBE. Chèn > Mô-đun chèn một mô-đun mới. Mã nên được dán vào mô-đun này. Khi bạn đã dán mã, bạn có thể đóng cửa sổ VBE. Alt + F8 mở danh sách macro.

Sub Join_tables()
Dim ws As Worksheet
Dim Array1 As Variant
Dim Array2 As Variant
Dim Array3() As Variant
Dim dict As Object
Dim dicKey As Variant
Dim str As String
Dim j As Long, k As Long, i As Long 'counters
Array1 = Application.InputBox("Select the 1st table.", "Get List", Type:=64)
Array2 = Application.InputBox("Select the 2nd table.", "Get List", Type:=64)
ReDim Array3(1 To UBound(Array1, 2), 1 To UBound(Array2, 2))
Set dict = CreateObject("Scripting.Dictionary")

For j = 2 To UBound(Array3, 1)
    Array3(j, 1) = Array1(1, j)
    For k = 2 To UBound(Array3, 2)
        If Array3(1, k) = vbNullString Then Array3(1, k) = Array2(1, k)

        For i = 2 To UBound(Array1, 1)
            If Array1(i, j) = "x" Then
                On Error Resume Next
                dict.Add Array1(i, 1), 0
                On Error GoTo 0
                If Err.Number = 457 Then Err.Clear
            End If
        Next

        For i = 2 To UBound(Array2, 1)
            If Array2(i, k) = "x" Then
                If dict.exists(Array2(i, 1)) Then
                    dict.Item(Array2(i, 1)) = 1
                End If
            End If
        Next

        str = vbNullString
        For Each dicKey In dict.keys
            If dict.Item(dicKey) = 1 Then
                str = str & dicKey & ", "
            End If
        Next
        dict.RemoveAll
        If str <> vbNullString Then str = Left(str, Len(str) - 2)

        Array3(j, k) = str

    Next 'k
Next 'j

Set ws = Worksheets.Add(After:=Worksheets(Worksheets.Count))
ws.Range("A1").Resize(UBound(Array3, 1), UBound(Array3, 2)) = Array3

Set ws = Nothing
Set dict = Nothing
End Sub