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

将两个表格更改为矩阵

1 个答案: