Excel: преобразование двух списков в матрицу

Question

У меня есть два списка в моей книге в настоящее время

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     |

Могу ли я каким-либо образом объединить эти два списка в матричном формате, как показано ниже?

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

Спасибо. Ценю всю помощь, которую я могу иметь.

Answer 1

Данный код делает то, что вы хотите. Я не ожидал, что это будет так долго, извините за это. Но я думаю, что это довольно эффективно. Извините за отсутствие комментариев, но я случайно потратил на это больше времени, чем ожидал. Таким образом, для вас это может быть трудно понять код. В любом случае, вопросы приветствуются.

По сути, вас просят выбрать 1-ю таблицу, а затем 2-ю (независимо от того, в какой таблице). Затем код отслеживает значения x из столбца в первой таблице и записывает имена, в которых есть x в этом столбце, в вещь, называемую "словарь". Тогда пришло время для 2 - й таблицы - если есть x рядом с некоторым именем, значение в словаре , что имя меняется на 1 Затем все имена, имеющие значение 1 в словаре, помещаются в строку str , и эта строка выводится в массив результатов Array3 . Этот процесс повторяется для каждого столбца в обеих входных таблицах. Наконец, массив результатов выводится на вновь созданную рабочую таблицу.

Alt + F11 открывает VBE. Вставить > Модуль вставляет новый модуль. Код должен быть вставлен в этот модуль. Когда вы вставите код, вы можете закрыть окно VBE. Alt + F8 открывает список макросов.

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