Это VBA или макрос, который вы можете запустить на своем листе. Вы должны нажать Alt+F11, чтобы вызвать приглашение Visual Basic для приложений, перейти к своей книге и 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
