Блог

Если в столбце A есть повторяющееся значение, я бы хотел, чтобы столбец C-E суммировался, а столбцы B и F отображали первое появившееся значение.

Например:

 A    B    C    D    E    F
h    4    2    3    1    5
h    3    3    5    3    7
h    4    4    7    5    4
h    1    1    4    1    4
k    9    3    6    2    4
k    5    3    6    2    7
k    4    3    9    2    7
k    9    4    1    1    4
  

Станет:

 A    B    C    D    E    F
h    4   10   19   10   5
k    9   13   22   7    4
  

Это код, который я использовал, когда мне дали 4 столбца, и он работал нормально. Теперь документы, которые я редактирую, имеют 6 столбцов, и я не могу заставить его работать сейчас.

 Sub mergeCategoryValues()
    Dim lngRow As Long

    With ActiveSheet
        lngRow = .Cells(65536, 1).End(xlUp).Row
        .Cells(1).CurrentRegion.Sort key1:=.Cells(1), Header:=xlYes

        Do
            If .Cells(lngRow, 1) = .Cells(lngRow - 1, 1) Then
                .Cells(lngRow - 1, 3) = .Cells(lngRow - 1, 3)   .Cells(lngRow, 3)
                .Cells(lngRow - 1, 4) = .Cells(lngRow - 1, 4)   .Cells(lngRow, 4)
                .Rows(lngRow).Delete
            End If

            lngRow = lngRow - 1
        Loop Until lngRow = 1
    End With
End Sub
  

Кто-нибудь сможет помочь с этим? Заранее спасибо.

Обратите внимание, где я добавил два новых оператора для суммирования ваших двух столбцов add’l в приведенном ниже коде, т.е.:

 .Cells(lngRow - 1, 5) = .Cells(lngRow - 1, 5)   .Cells(lngRow, 5)
.Cells(lngRow - 1, 6) = .Cells(lngRow - 1, 6)   .Cells(lngRow, 6)
  

По сути, предоставленный вами код начинается с последней строки вашего рабочего листа и продвигается вверх, строка за строкой, добавляя значения для текущей строки в строку прямо над ней, если значения в столбце 1 совпадают. 5 6 Добавленные мной строки и относятся к номерам столбцов, которые будут агрегироваться.

 Sub mergeCategoryValues()
Dim lngRow As Long

With ActiveSheet
    lngRow = .Cells(65536, 1).End(xlUp).Row
    .Cells(1).CurrentRegion.Sort key1:=.Cells(1), Header:=xlYes

    Do
        If .Cells(lngRow, 1) = .Cells(lngRow - 1, 1) Then
            .Cells(lngRow - 1, 3) = .Cells(lngRow - 1, 3)   .Cells(lngRow, 3)
            .Cells(lngRow - 1, 4) = .Cells(lngRow - 1, 4)   .Cells(lngRow, 4)

            ' added the next two statements for your new columns
            .Cells(lngRow - 1, 5) = .Cells(lngRow - 1, 5)   .Cells(lngRow, 5)
            .Cells(lngRow - 1, 6) = .Cells(lngRow - 1, 6)   .Cells(lngRow, 6)
            .Rows(lngRow).Delete
        End If

        lngRow = lngRow - 1
    Loop Until lngRow = 1
End With
End Sub
  

Вы также можете сделать это с помощью Power Query, доступного в Windows Excel 2010 и O365 На самом деле это всего лишь один шаг группировки по столбцу A и выполнения правильной агрегации по столбцам B ..F. В третьей строке MCode ниже происходит все волшебство.

• примечание. при использовании любого из приведенных ниже методов сортировка данных не требуется.
• Кроме того, либо легко модифицируется для добавления / удаления столбцов; и / или решить, для каких строк возвращать либо СУММУ, либо ПЕРВУЮ запись.

Хотя вы можете вставить код M в расширенный редактор, я предлагаю выполнить шаги по его созданию самостоятельно, особенно если ваши столбцы имеют разные имена или если значения не являются целыми числами

• выберите некоторую ячейку в таблице
• Данные / Получение и преобразование / из таблицы / Диапазона
• Когда откроется редактор PQ
• Выберите столбец A и group by
• Выберите Дополнительно
  • Введите Sum агрегацию для каждого столбца B ..F
  • После того, как вы это сделаете
    • Главная / Расширенный редактор
    • Вы увидите таблицу.Групповая строка содержит несколько List.Sum операций для каждого из этих агрегированных столбцов.
      • Измените List.Sum на List.First для 2-го и последнего столбцов.
      • Вы также можете изменить заголовки столбцов в той же строке кода.

M Код

     Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"A", type text}, {"B", Int64.Type}, {"C", Int64.Type}, {"D", Int64.Type}, {"E", Int64.Type}, {"F", Int64.Type}}),
    #"Grouped Rows" = Table.Group(#"Changed Type", {"A"}, {{"First B", each List.First([B]), type nullable number}, 
        {"Sum C", each List.Sum([C]), type nullable number}, {"Sum D", each List.Sum([D]), type nullable number},
        {"Sum E", each List.Sum([E]), type nullable number},{"First F", each List.First([F]), type nullable number}})
in
    #"Grouped Rows"

  

Если вы должны использовать VBA, я предлагаю собирать данные для каждого элемента в столбце A в словарь, где словарная запись — это другой словарь, который суммирует значения для каждого столбца (за исключением первого и последнего столбцов, где сохраняется только первое значение).

Обратите внимание, что мы работаем с массивом VBA, поскольку обычно это на порядок быстрее, чем работа с рабочим листом.

 'Set reference to Microsoft Scripting Runtime (preferable)
'or convert to late binding
Option Explicit
Sub mergeCategoryValues()
    Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range
    Dim vSrc As Variant, vRes As Variant
    Dim Da As Dictionary, Dv As Dictionary
    Dim I As Long, J As Long, sKeyA As String
    Dim v, w
    
'set the Source and results worksheets, ranges
Set wsSrc = Worksheets("sheet6")
Set wsRes = Worksheets("sheet6")
    Set rRes = wsRes.Cells(12, 16)
    
'read source data into vba array for faster processing
With wsSrc
    vSrc = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(columnsize:=6)
End With

'read the values into dictionaries
'each dictionary of col a will contain dictionary with the other column values, either summed or just first
Set Da = New Dictionary
    Da.CompareMode = TextCompare
    
For I = 2 To UBound(vSrc, 1) 'skip the header row
    sKeyA = vSrc(I, 1)
    
    'initial set up for column A ID
    If Not Da.Exists(sKeyA) Then
        Set Dv = New Dictionary
            Dv.CompareMode = TextCompare
        For J = 2 To UBound(vSrc, 2)
            Dv.Add Key:=vSrc(1, J), Item:=vSrc(I, J)
        Next J
        
        Da.Add Key:=sKeyA, Item:=Dv
        
    Else  'Column A entry already exists
        'we just add the value from  column C..next to last column
        '  leaving the first entry in columns A and the last column
        For J = 3 To UBound(vSrc, 2) - 1
            Da(sKeyA)(vSrc(1, J)) = Da(sKeyA)(vSrc(1, J))   vSrc(I, J)
        Next J
    End If
Next I

'can sort the Da keys if necessary
'create results array
ReDim vRes(0 To Da.Count, 1 To UBound(vSrc, 2))

'Headers
For J = 1 To UBound(vSrc, 2)
    vRes(0, J) = vSrc(1, J)
Next J

'Data
I = 0
For Each v In Da.Keys
    I = I   1
    vRes(I, 1) = v
    J = 1
    For Each w In Da(v)
        J = J   1
        vRes(I, J) = Da(v)(w)
    Next w
Next v

'write to the worksheet
Set rRes = rRes.Resize(rowsize:=UBound(vRes, 1)   1, columnsize:=UBound(vRes, 2))
Application.ScreenUpdating = False
With rRes
    .EntireColumn.Clear
    .Value = vRes
    .HorizontalAlignment = xlCenter
    .Style = "Output" 'can change or ignore this, especially if non-english version
    .EntireColumn.AutoFit
End With
     
End Sub