Изменение двух таблиц в матрице

Question

У меня есть 2 таблицы с данными ниже.

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  | 

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

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

У меня есть опыт кодирования, но не очень сильный в VBA. Цените, если кто-нибудь может дать мне несколько примеров кода для начала.

Есть 27 систем, 21 процесс и 188 имен. Таким образом, это займет какое-то время вручную.

спасибо.

Answer 1

Комментарии приведены в коде HTH.

Option Explicit 

Sub Main(): On Error GoTo errMain 
    Dim system As Range 
    Dim process As Range 

    ' Select ranges of systems and processes 
    Set system = Application.InputBox(_ 
     prompt:="Go to sheet with 'system' data and select it", Title:="S Y S T E M", Type:=8) 
    Set process = Application.InputBox(_ 
     prompt:="Go to sheet with 'process' data and select it", Title:="P R O C E S S", Type:=8) 

    ' Do the merge 
    MergeIt system, process 

    Exit Sub 

errMain: 
    MsgBox Err.Description, vbCritical 
End Sub 

Private Sub MergeIt(system As Range, process As Range) 

    Dim processData As Range 
    Dim processColumn As Range 
    Dim processName As String 
    Dim processUsers As Variant 
    Dim processValues As Variant 
    Dim processIndex As Integer 

    Dim systemData As Range 
    Dim systemColumn As Range 
    Dim systemName As String 
    Dim systemUsers As Variant 
    Dim systemValues As Variant 
    Dim systemIndex As String 

    ' Add new sheet where the merged data will be stored 
    Dim mergedSheet As Worksheet 
    Set mergedSheet = Worksheets.Add(after:=Worksheets(Worksheets.Count)) 
    mergedSheet.Name = "Merged" & _ 
     Year(Now) & Month(Now) & Day(Now) & Hour(Now) & Minute(Now) & Second(Now) 

    ' Get process and system users as first column without the first cell 
    processUsers = process.Columns(1).Offset(1, 0).Resize(process.Rows.Count - 1, 1) 
    systemUsers = system.Columns(1).Offset(1, 0).Resize(system.Rows.Count - 1, 1) 

    ' Get process and system data as all columns except the first one where the users are 
    Set processData = process.Offset(0, 1).Resize(process.Rows.Count, process.Columns.Count - 1) 
    Set systemData = system.Offset(0, 1).Resize(system.Rows.Count, system.Columns.Count - 1) 

    processIndex = 1 

    ' Go the process data by columns. 
    ' Add process name to result sheet and for each process column go through 
    ' all system columns and do the merge 
    For Each processColumn In processData.Columns 

     processIndex = processIndex + 1 
     processName = processColumn.Cells(1).Value 
     mergedSheet.Rows(1).Cells(processIndex).Value = processName 
     processValues = processColumn.Offset(1, 0).Resize(processColumn.Rows.Count - 1, 1) 
     systemIndex = 1 

     For Each systemColumn In systemData.Columns 

      systemIndex = systemIndex + 1 
      systemValues = systemColumn.Offset(1, 0).Resize(systemColumn.Rows.Count - 1, 1) 

      If mergedSheet.Columns(1).Cells(systemIndex).Value = "" Then 
       systemName = systemColumn.Cells(1).Value 
       mergedSheet.Columns(1).Cells(systemIndex).Value = systemName 

      End If 

      mergedSheet.Cells(systemIndex, processIndex).Value = _ 
       IntersectOfValues(processUsers, processValues, systemUsers, systemValues) 

     Next systemColumn 
    Next processColumn 

End Sub 

Private Function IntersectOfValues(_ 
    ByVal processUsers As Variant, _ 
    ByVal processValues As Variant, _ 
    ByVal systemUsers As Variant, _ 
    ByVal systemValues As Variant) As String 

    Dim i As Integer 
    Dim j As Integer 

    ' Go through all process and system values. 
    ' Compare names which correspond to values. 
    ' Append the name to result if it was found in both process and system values. 
    For i = LBound(processValues) To UBound(processValues) 
     If Trim(processValues(i, 1)) = "" Then _ 
      GoTo nextI 

     For j = LBound(systemValues) To UBound(systemValues) 
      If Trim(systemValues(j, 1)) = "" Then _ 
       GoTo nextJ 

      If systemUsers(j, 1) = processUsers(i, 1) Then 
       IntersectOfValues = IntersectOfValues & processUsers(i, 1) & "," 
       Exit For 
      End If 

nextJ: 
     Next j 

nextI: 
    Next i 

    If Len(IntersectOfValues) = 0 Then _ 
     Exit Function 

    If Right(IntersectOfValues, 1) = "," Then _ 
     IntersectOfValues = Left(IntersectOfValues, Len(IntersectOfValues) - 1) 
End Function