Excel 重复行合并

Question

有人可以帮我解决这个问题吗？我不知道该怎么办。

以下是数据集

我想将每种方法每种颜色的数据合并为一行。

在这个例子中Total + Blue，有两行数据，但我想将它们合并为一行。

每列每种颜色和方法只有一个数据点，因此不会覆盖任何内容。

相同的颜色并不总是彼此相邻。

相同的颜色在每种方法中可能有多行，但每种方法和颜色在每列中只有一个唯一的数据点。

列的数量也将是可变的（从#1 到许多）。

某些方法 + 颜色组合会缺少数据 - 这些可以忽略。任何没有重复行数据的行也可以忽略，例如绿色和紫色。

这是理想的输出。

我一直通过手动复制和粘贴行并选择跳过空白选项，然后手动删除复制的行。

提前致谢

Answer 1

此 VBA 代码应该可以工作

Public Sub combineRows()
    Dim wkb As Workbook
    Dim wks, wks1 As Worksheet
    'Define variables
    titleRow = 1
    namecolumns = 2
    Set wkb = ThisWorkbook
    Set wks = wkb.Sheets("Sheet1") 'Source sheet
    Set wks1 = wkb.Sheets("Sheet2") 'Destination sheet
    'Clear the destination Sheet
    wks1.Rows.Clear
    'Count rows and columns on source sheet
    totalrows = wks.Cells(Rows.Count, 1).End(xlUp).row
    totalcolumns = wks.Cells(titleRow, columns.Count).End(xlToLeft).Column
    'Copy title row
    wks.Rows(titleRow).Copy wks1.Rows(titleRow)
    wks1row = titleRow + 1
    'Iterates each row on source sheet
    For i = titleRow + 1 To totalrows
        original = concnames(wks, i, namecolumns)
        totalrowswks1 = wks1.Cells(Rows.Count, 1).End(xlUp).row
        coincidence = False
        'Check if the same name exists on Destination sheet
        For k = titleRow + 1 To totalrowswks1
            originalwks1 = concnames(wks1, k, namecolumns)
            If original = originalwks1 Then
                coincidence = True
                k = totalrowswks1
            End If
        Next k
        'If the name exists on destination skips it
        If coincidence = False Then
            'Copy the entire row to destination
            For j = 1 To totalcolumns
                wks1.Cells(wks1row, j) = wks.Cells(i, j)
            Next j
            'Check on source other rows with the same name to copy its data
            For j = i + 1 To totalrows
                other = concnames(wks, j, namecolumns)
                If other = original Then
                    For k = namecolumns + 1 To totalcolumns
                        theCell = wks.Cells(j, k)
                        If theCell <> "" Then
                            wks1.Cells(wks1row, k) = theCell
                        End If
                    Next k
                End If
            Next j
            wks1row = wks1row + 1
        End If
    Next i
End Sub

Public Function concnames(ByVal SheetName As Worksheet, therow, thecolumns)
    'This function concatenates the values on the namecolumns to create
    'a single one string.
    'It makes very easy to compare rows.
    originalvalue = ""
    For m = 1 To thecolumns
        cellData1 = SheetName.Cells(therow, m)
        originalvalue = originalvalue & cellData1
    Next m
    concnames = originalvalue
End Function

使用ALT+打开 VBA / 宏F11，在本工作簿插入新的模块并将代码粘贴到右侧。

检查代码中的变量titleRow和namecolumns是否与您的案例相符以及工作表名称，然后运行它。

Answer 2

您可以使用数据透视表。

将“方法”和“颜色”拖到“行”区域

将 # 拖到值区域

确保 # 设置为计算总和

格式化以表格形式显示，并重复所有标签

以下是您的数据的一个结果：