Це VBA або макрос, який ви можете запустити на своєму аркуші. Вам потрібно натиснути alt+, F11щоб відкрити вікно Visual Basic for Application, перейти до вашої робочої книги right click - insert - moduleта вставити цей код туди. Потім можна запустити модуль зсередини VBA, натиснувши F5. Цей макрос має назву "тест"
Sub test()
'define variables
Dim RowNum as long, LastRow As long
'turn off screen updating
Application.ScreenUpdating = False
'start below titles and make full selection of data
RowNum = 2
LastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
Range("A2", Cells(LastRow, 4)).Select
'For loop for all rows in selection with cells
For Each Row In Selection
With Cells
'if customer name matches
If Cells(RowNum, 1) = Cells(RowNum + 1, 1) Then
'and if customer year matches
If Cells(RowNum, 4) = Cells(RowNum + 1, 4) Then
'move attribute 2 up next to attribute 1 and delete empty line
Cells(RowNum + 1, 3).Copy Destination:=Cells(RowNum, 3)
Rows(RowNum + 1).EntireRow.Delete
End If
End If
End With
'increase rownum for next test
RowNum = RowNum + 1
Next Row
'turn on screen updating
Application.ScreenUpdating = True
End Sub
Це буде проходити через впорядковану електронну таблицю та об’єднувати послідовні рядки, які відповідають як клієнту, так і році та видалити порожній рядок. Електронна таблиця повинна бути відсортована так, як ви її представили, за клієнтами та роками за зростанням, цей конкретний макрос не буде виходити за межі послідовних рядків .
Редагувати - це цілком можливо, моє with statementзовсім непотрібне, але це нікому не шкодить ..
ПЕРЕМОЖЕНО 28.02.14
Хтось використав цю відповідь в іншому запитанні, і коли я повернувся, я подумав, що ця VBA погана. Я переробив це -
Sub CombineRowsRevisited()
Dim c As Range
Dim i As Integer
For Each c In Range("A2", Cells(Cells.SpecialCells(xlCellTypeLastCell).Row, 1))
If c = c.Offset(1) And c.Offset(,4) = c.Offset(1,4) Then
c.Offset(,3) = c.Offset(1,3)
c.Offset(1).EntireRow.Delete
End If
Next
End Sub
Переглянуто 05.04.16
Запитуємо ще раз Як об’єднати значення з декількох рядків в один ряд? Майте модуль, але потрібні пояснення змінних, і знову це досить погано.
Sub CombineRowsRevisitedAgain()
Dim myCell As Range
Dim lastRow As Long
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
For Each myCell In Range(Cells("A2"), Cells(lastRow, 1))
If (myCell = myCell.Offset(1)) And (myCell.Offset(0, 4) = myCell.Offset(1, 4)) Then
myCell.Offset(0, 3) = myCell.Offset(1, 3)
myCell.Offset(1).EntireRow.Delete
End If
Next
End Sub
Однак, залежно від проблеми, може бути краще, щоб step -1це було рядкове число, щоб нічого не пропустили.
Sub CombineRowsRevisitedStep()
Dim currentRow As Long
Dim lastRow As Long
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
For currentRow = lastRow To 2 Step -1
If Cells(currentRow, 1) = Cells(currentRow - 1, 1) And _
Cells(currentRow, 4) = Cells(currentRow - 1, 4) Then
Cells(currentRow - 1, 3) = Cells(currentRow, 3)
Rows(currentRow).EntireRow.Delete
End If
Next
End Sub
