Я думаю, что этот гарантирует быстрый макрос, попробуйте (на копии ваших данных в случае проблем! Я проверил это на Excel 2003 здесь, и это работает для меня, но, как всегда, лучше быть осторожным!) ,
Сначала он выберет весь активный у вас лист и отсортирует по A
столбцу. Затем он проверит весь A
столбец на предмет совпадений (совпадение на 100%, это также чувствительно к регистру) и сложит их значения в B
столбце и удалит дублирующиеся строки. Данные в повторяющихся строках в других столбцах B
будут потеряны.
Я добавил пару NOTE
комментариев в код с подсказками к битам, которые легче всего настроить.
Sub SortAndMerge()
'Sort first
'NOTE: Change this select if you wish the sort to be more precise
Cells.Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'And then merge
Range("A1").Select
'Keep going until we run out of entires in the first column
Do While ActiveCell.Value <> 0
'Loop while the row below matches
Do While ActiveCell.Offset(1, 0).Value = ActiveCell.Value
'The value on this row += the value on the next row
'NOTE: Changing the 1 in the second places on *all three* of these
' offsets will change the row being merged (A+1=B, A+2=C, etc)
ActiveCell.Offset(0, 1).Value = ActiveCell.Offset(0, 1).Value _
+ ActiveCell.Offset(1, 1).Value
'Delete the duplicate row
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.Delete Shift:=xlUp
'Reselect the top row for this group
ActiveCell.Offset(-1, 0).Select
Loop
'Step to next row
ActiveCell.Offset(1, 0).Select
Loop
End Sub