# Объединить строки & Sum значений в рабочем листе

 Обновить April 2019 Просмотры 866 раз
1

У меня есть Excel лист с ниже (трубы «|», чтобы разграничивать столбцы) данных.

``````A|B|C|X|50|60
D|E|F|X|40|30
A|B|C|X|10|20
A|B|C|Y|20|20
A|B|C|X|20|70
D|E|F|X|10|50
A|B|C|Y|10|10
``````

В результате я пытаюсь получить это:

``````A|B|C|X|80|150
A|B|C|Y|30|30
D|E|F|X|50|80
``````

Значения A, B, C и D, E, F, как уникальные идентификаторы. На самом деле только А или D могут быть рассмотрены. Значения X и Y, как «типы», и целые числа приведены значения суммы. Этот образец был упрощен, есть тысячи уникальных идентификаторов, десятки типов и десятка значений суммы. Строки не сортируется, типы могут быть расположены в более высоких или более низких рядах. Я пытаюсь избежать использования сводной таблицы.

``````Dim LastRow As Integer
Dim LastCol As Integer
Dim i As Integer

LastCol = Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
LastRow = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To LastRow
????
Next i
``````

Код выше добирается до точки пробегает по строкам, но я не ясно о том, что после этой точки.

### 1 ответы

1
1. Sort them on all alphabetic columns you deem important.
2. In an unused column to the right use a formula like the following in the second row,

=IF(\$A2&\$B2&\$C2&\$D2=\$A3&\$B3&\$C3&\$D3, "", SUMIFS(E:E,\$A:\$A, \$A2,\$B:\$B, \$B2,\$C:\$C, \$C2,\$D:\$D, \$D2))

3. Copy that formula right one column then fill both columns down as far as your data goes

4. Filter on the two columns, removing blanks. 5. Optionally copy the data to a new report worksheet and remove columns E & F.

A more automated approach could be achieved with some form of array and some simple mathematical operations. I've chosen a dictionary object in order to take use of its indexed Key to recognize patterns in the first four alphabetic identifiers.

To use a scripting dictionary, you need to go into the VBE's Tools ► References and add Microsoft Scripting Runtime. The following code will not compile without it.

The following has been adjusted for dynamic columns of keys and integers.

``````Sub rad_collection()
Dim rw As Long, nc As Long, sTMP As String, v As Long, vTMP As Variant
Dim i As Long, iNumKeys As Long, iNumInts As Long

iNumKeys = 5    'possibly calculated by num text (see below)
iNumInts = 2    'possibly calculated by num ints (see below)

With ThisWorkbook.Sheets("Sheet4").Cells(1, 1).CurrentRegion
'iNumKeys = Application.CountA(.Rows(2)) - Application.Count(.Rows(2))  'alternate count of txts
'iNumInts = Application.Count(.Rows(2))    'alternate count of ints
For rw = 2 To .Cells(Rows.Count, 1).End(xlUp).row
vTMP = .Cells(rw, 1).Resize(1, iNumKeys).Value2
sTMP = Join(Application.Index(vTMP, 1, 0), Chr(183))
Else
For v = LBound(vTMP) To UBound(vTMP)
vTMP(v) = vTMP(v) + .Cells(rw, iNumKeys + 1 + v).Value2
Next v
End If

Next rw

rw = 1
nc = iNumKeys + iNumInts + 1
.Cells(rw, nc + 1).CurrentRegion.ClearContents  'clear previous
.Cells(rw, nc + 1).Resize(1, nc - 1) = .Cells(rw, 1).Resize(1, nc - 1).Value2
'Debug.Print vTMP & "|" & dRADs.Item(vTMP)
rw = rw + 1
.Cells(rw, nc + 1).Resize(1, iNumKeys) = Split(vTMP, Chr(183))
.Cells(rw, nc + iNumKeys + 1).Resize(1, iNumInts) = Split(dRADs.Item(vTMP), Chr(183))
.Cells(rw, nc + iNumKeys + 1).Resize(1, iNumInts) = _
.Cells(rw, nc + iNumKeys + 1).Resize(1, iNumInts).Value2
Next vTMP
End With

End Sub
``````

Just run the macro against the numbers you have provided as samples. I've assumed some form of column header labels in the first row. The dictionary object is populated and duplicates in the combined identifiers have their numbers summed. All that is left is to split them back up and return them to the worksheet in an unused area. Location of Microsoft Scripting Runtime - In the Visual Basic Editor (aka VBE) choose Tools ► References (Alt+T,R) and scroll down a little more than halfway to find it. 