Excel дублирование строк

Question

Может ли кто-нибудь помочь мне с этим, я понятия не имею, как это сделать.

Вот набор данных

Я хочу объединить данные каждого цвета из каждого метода в 1 строку.

В этом примере Total + Blue содержит данные в 2 строки, но я хотел бы объединить их в одну строку.

В каждом столбце для каждого цвета и метода будет только одна точка данных, поэтому ничего не будет перезаписано.

Одни и те же цвета не всегда будут соседствовать друг с другом.

Один и тот же цвет может иметь много строк на метод, но опять же будет иметь уникальную точку данных в каждом столбце для метода и цвета.

Количество столбцов также будет переменным (# 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

Откройте VBA / Macros с помощью ALT + F11, в ThisWorkbook вставьте новый модуль и вставьте код с правой стороны.

Проверьте в коде, что переменные titleRow и namecolumns совпадают с вашим регистром, а также имена листов, и запустите его.

Answer 2

Вы можете использовать сводную таблицу.

Перетащите Методы и Цвет в область строк

Перетащите # в область значений

Убедитесь, что # установлены для вычисления суммы

Формат для отображения в табличной форме и повтор всех меток

Ниже приведен один результат с вашими данными: