Excel vba macro om rijen te kopiëren gebaseerd op de waarde van een cell

Excel

Deze is alleen voor de Excel-nerds onder ons!

Om data van DUO klaar te maken voor Fineo (voor mijn visualisatie van doorstroom PO-VO), moest ik rijen dupliceren. De data zegt bijvoorbeeld dat van school X er 3 leerlingen naar school Y gaan. Dan is het nodig voor Sankey diagrammen dat de stroom van school X naar school Y 3x vermeld wordt.

Nu bevatte het bestand zo’n 47.000 records. Dus handmatig dit doen, is niet te doen. Ik vond een macro die het volgende kan:

  • Zoek op werkblad 1 in rij 1 en kolom X naar een waarde. (In dit geval het aantal leerlingen dat doorstroomt.)
  • Kopieer op werkblad 2 deze rij precies zo vaak als de gevonden waarde.
  • Ga door voor de volgende rij op werkblad 1.

De code klopte alleen niet meer helemaal voor de huidige Office versie en werkte ook niet met grote aantallen records. Hieronder mijn versie:

Sub DuplicateRows()
    Dim currentRow As Long
    Dim currentNewSheetRow As Long: currentNewSheetRow = 1

    For currentRow = 1 To 32768 'The last row of your data
    Dim timesToDuplicate As Integer
    timesToDuplicate = CInt(Worksheets("Sheet1").Range("J" & currentRow).Value)
    Dim i As Integer
    For i = 1 To timesToDuplicate
        Worksheets("Sheet2").Range("A" & currentNewSheetRow).Value = Worksheets("Sheet1").Range("A" & currentRow).Value
        Worksheets("Sheet2").Range("B" & currentNewSheetRow).Value = Worksheets("Sheet1").Range("B" & currentRow).Value
        Worksheets("Sheet2").Range("C" & currentNewSheetRow).Value = Worksheets("Sheet1").Range("C" & currentRow).Value
        Worksheets("Sheet2").Range("D" & currentNewSheetRow).Value = Worksheets("Sheet1").Range("D" & currentRow).Value
        Worksheets("Sheet2").Range("E" & currentNewSheetRow).Value = Worksheets("Sheet1").Range("E" & currentRow).Value
        Worksheets("Sheet2").Range("F" & currentNewSheetRow).Value = Worksheets("Sheet1").Range("F" & currentRow).Value
        Worksheets("Sheet2").Range("G" & currentNewSheetRow).Value = Worksheets("Sheet1").Range("G" & currentRow).Value
        Worksheets("Sheet2").Range("H" & currentNewSheetRow).Value = Worksheets("Sheet1").Range("H" & currentRow).Value
        Worksheets("Sheet2").Range("I" & currentNewSheetRow).Value = Worksheets("Sheet1").Range("I" & currentRow).Value
        currentNewSheetRow = currentNewSheetRow + 1
    Next i
Next currentRow
End Sub

Om dit voor andere bestanden te gebruiken, moet de code andere waardes hebben voor het maximale aantal rijen, de kolom waar op gezocht wordt (hier was dat “J”) en het aantal velden dat gekopieerd moet worden.

Geef een reactie

Vul je gegevens in of klik op een icoon om in te loggen.

WordPress.com logo

Je reageert onder je WordPress.com account. Log uit / Bijwerken )

Twitter-afbeelding

Je reageert onder je Twitter account. Log uit / Bijwerken )

Facebook foto

Je reageert onder je Facebook account. Log uit / Bijwerken )

Google+ photo

Je reageert onder je Google+ account. Log uit / Bijwerken )

Verbinden met %s