Question

我有一个包含4,000行的Excel电子表格，其中包含以下七列。我想要关闭第一列并组合所有匹配的行。因此，对于下面的前两行，它们将在它们各自的列中的单个单元中合并为具有C2＆amp; C3，F2＆amp; F3和G2＆amp; G3的一行。 例如：

我希望合并的行看起来像这样：

8876    AIX 1.1.1.1,2.2.2.2 Oracle 11.2.0.3.15 Purple,Blue Jim Smith,Bob Guy

原始表格如下：

8876    AIX 1.1.1.1 Oracle  11.2.0.3.15 Purple  Jim Smith
8876    AIX 2.2.2.2 Oracle  11.2.0.3.15 Blue    Bob Guy

谢谢，克里斯

Answer 1

您可以使用此

Public Sub StartMerge()

    MergeRecords ActiveSheet.Range("$A$10:$H$19")

End Sub

Public Sub MergeRecords(rInputRange As Range, Optional sDelimiter As String = ",")

    Dim oRow        As Range
    Dim sPrevKey    As String
    Dim oPrevRow    As Range
    Dim i           As Long
    Dim j           As Long
    Dim bLoop       As Boolean
    Dim lRowIndex   As Long
    Dim aItems()    As String

    bLoop = True
    lRowIndex = 1

    Do While bLoop
        Set oRow = rInputRange.Rows(lRowIndex)
        If oRow.Cells(1) = sPrevKey Then
            For i = 2 To oRow.Cells.Count
                If InStr(oRow.Cells(i), sDelimiter) <> 0 Then
                    aItems = Split(oRow.Cells(i), sDelimiter)
                    For j = 0 To UBound(aItems)
                        If InStr(oPrevRow.Cells(i), aItems(j)) = 0 Then
                            oPrevRow.Cells(i) = oPrevRow.Cells(i) & "," & aItems(j)
                        End If
                    Next j
                Else
                    If InStr(oPrevRow.Cells(i), oRow.Cells(i)) = 0 Then
                        oPrevRow.Cells(i) = oPrevRow.Cells(i) & "," & oRow.Cells(i)
                    End If
                End If
            Next i
            oRow.EntireRow.Delete xlUp
        Else
            Set oPrevRow = oRow
            sPrevKey = oRow.Cells(1)
            lRowIndex = lRowIndex + 1
        End If
        If lRowIndex > rInputRange.Rows.Count Then bLoop = False
    Loop

End Sub

请先备份。它假定第一列包含密钥

根据第一列组合多行

1 个答案: