Dit is VBA, of een macro die je op je werkblad kunt uitvoeren. U moet alt+F11 indrukken om de Visual Basic for Application prompt op te roepen, ga naar uw werkmap en right click - insert - module en plak daar deze code in. Vervolgens kunt u de module vanuit VBA uitvoeren door op F5 te drukken. Deze macro heet “test”
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
Hiermee doorloop je een gesorteerd spreadsheet en combineer je opeenvolgende rijen die zowel met de klant als met het jaar overeenkomen en verwijder je de nu lege rij. De spreadsheet moet gesorteerd zijn zoals je hem hebt gepresenteerd, klanten en jaren oplopend, deze specifieke macro kijkt niet verder dan opeenvolgende rijen.
Bewerken - het is heel goed mogelijk dat mijn with statement helemaal niet nodig is, maar het schaadt niemand…
REVISITED 02/28/14
Iemand gebruikte dit antwoord in een andere vraag en toen ik terugging vond ik deze VBA slecht. Ik heb het opnieuw gedaan -
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
Revisited 05/04/16
Opnieuw gevraagd Hoe combineer je waarden uit meerdere rijen in een enkele rij? Heb een module, maar heb de variabelen nodig om uit te leggen en weer is het vrij slecht.
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
Afhankelijk van het probleem kan het echter beter zijn om step -1 op een rijnummer te zetten, zodat niets wordt overgeslagen.
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