Jede n’te Zeile kopieren (VBA)

Jede n’te Zeile kopieren (VBA/Makro)

Die Auf­ga­be

Aus ein­er beste­hen­den Ta­bel­le soll (beispiel­sweise) jede vier­te Zei­le in ein neu­es Tabel­len­blatt der gle­ichen Ar­beits­map­pe ko­piert wer­den. Es gibt eine Über­schrift-Zeile in der Quell-Ta­bel­le, wel­che getren­nt in die Ziel-Ta­bel­le ko­piert wer­den soll. Die Zäh­lung der Dat­en soll mit der Zei­le unter­halb der Über­schrift, also (im Nor­mal­fall)  ab Zei­le 2 begin­nen. Das be­deu­tet in die­sem Bei­spiel, dass die Zei­len 5, 9, 13, … ko­piert wer­den sol­len

▲ nach oben …

Die Lö­sung

Zu­ge­ge­ben, mit ein­er Hil­f­ss­palte geht es auch ohne VBA. Le­sen Sie hier mehr dazu. In der zum Down­load bere­it gestell­ten Ar­beits­map­pe sind es das drit­te und vier­te Reg­is­ter, wo kein VBA einge­set­zt wur­de und über die Hil­f­ss­palte ein Fil­ter geset­zt wor­den ist. Die ge­fil­ter­ten Dat­en sind dann per C:P in die nach­fol­gende Ta­bel­le einge­fügt wor­den.

Mit VBA, also ein­er Ma­kro-Lö­sung ist das al­les im­mer dann viel ein­fach­er, wenn solch eine An­for­de­rung öf­ter ein­mal vor­kommt und dann vielle­icht auch noch die Daten­bere­iche (Zei­len und Spal­ten) unter­schiedlich groß sind. Und wenn es mal jede zwei­te, fün­fte, zehn­te, … Zei­le ist, die ko­piert wer­den soll, dann ge­nügt eine ein­zi­ge klei­ne Anpas­sung im Code, dass entwed­er bei je­dem Auf­ruf in ei­nem klei­nen Fen­ster (ein­er Input­Box) die „Sprung­weite” abge­fragt wird oder Sie än­dern im Code ge­nau die­sen Wert an 1 Stel­le.

Die Da­tei mit dem Source­code und vier Tabel­len­blät­tern find­en Sie hier zum Down­load, den Code habe ich di­rekt hier­un­ter noch ein­mal dar­ge­stellt; er liegt auch gepack­te Text­datei für Sie bere­it. Es ist ein aus mein­er Sicht „gesun­der” Mit­tel­weg zwis­chen Ge­schwin­dig­keit und Nachvol­lziehbarkeit des Codes. Im An­schluss fol­gen noch ei­ni­ge we­ni­ge Kom­mentare dazu, aber in ers­ter Lin­ie ist die­se Rou­tine für User ge­dacht, die erforder­lichen­falls Anpas­sun­gen vor­neh­men kön­nen und schon wis­sen, was sie da ger­ade tun. 😉

▲ nach oben …

Der Code

Option Explicit

Sub JedeXteZeile()
   Dim wksSrc As WorkSheet, wksDst As WorkSheet
   Dim rngSrcData As Range, c As Range
   Dim lRow As Long, Anz As Long, lCol As Integer
   Dim aDaten()
   Dim Sprung As Integer, i As Long, ArrZe As Long

   Set wksSrc = Sheets("Tabelle1")
   Set wksDst = Sheets("Tabelle2")
   Sprung = 4 ‚jede 4. Zeile
   With wksSrc
      lRow = .Cells(Rows.Count, 1).End(xlUp).Row ‚Spalte_A
      lCol = .Cells(1, Columns.Count).End(xlToLeft).Column
      Set rngSrcData = .Range(.Cells(2, 1), .Cells(lRow, 1))
      Anz = Int((rngSrcData.Rows.Count) / 4)
      ReDim aDaten(Anz, lCol)

      For i = 1 To lCol ‚Überschrift
         aDaten(0, i – 1) = .Cells(1, i)
      Next i
      
      i = 1
      ArrZe = 1
      For Each c In rngSrcData
         If (c.Row – 1) Mod 4 = 0 Then
            For i = 1 To lCol
               aDaten(ArrZe, i – 1) = .Cells(c.Row, i)
            Next i
            ArrZe = ArrZe + 1
         End If
      Next c
   End With

   wksDst.Range("A1").Resize(Anz + 1, lCol) = aDaten()
   Set wksSrc = Nothing
   Set wksDst = Nothing
   Set rngSrcData = Nothing
End Sub

▲ nach oben …

Ei­ni­ge we­ni­ge An­mer­kun­gen zum Code

Hin­weis: Ich neh­me hier Be­zug auf die Zeilen­num­mern, wie sie sich in die­ser *.zip-gepack­ten Text-Da­tei mit dem Code dar­stel­len. Wenn Sie zum Betra­cht­en den sehr gu­ten kosten­losen Edi­tor No­te­pad++ ein­set­zen, dann wer­den Ih­nen auch die Zeilen­num­mern an­ge­zeigt (gilt aber auch für ver­schiedene an­de­re Edi­toren). Falls Sie MS Word oder eine an­de­re Textver­ar­beitung dazu ein­set­zen, bit­te im An­schluss nicht spe­ich­ern, da die­se Pro­gramme die Struk­tur ein­er Text-Da­tei zer­stören.

Hier nun die einzel­nen Hin­weis-Punk­te:

  • Aus Grün­den der Ge­schwin­dig­keit wird ein Ar­ray ver­wen­det, welch­es vor dem Fül­len mit den berech­neten Wer­ten dimen­sion­iert wird.
  • Zei­len 10–11: Hier müs­sen bei Be­darf die Na­men der Ta­bel­len an­ge­passt wer­den.
  • Zei­le 12: Hier ein­ge­ben, in wel­chem Inter­vall die Zei­len ko­piert wer­den sol­len.
  • Zei­len 21–23: Die Über­schriften in das Ar­ray schrei­ben.
  • Zei­len 27–34: Jede 4. Zei­le (oder ent­spre­chend der Vari­ablen Sprung)
  • Zei­le 36: Das Ar­ray in die Ziel-Ta­bel­le Zel­le A1 schrei­ben

[NachOben­Let­zte Ver­weis=„ML: Jede n’te Zei­le ko­pie­ren”]

Dieser Beitrag wurde unter Mit VBA/Makro, Musterlösungen, Tabelle und Zelle abgelegt und mit , , , verschlagwortet. Setze ein Lesezeichen auf den Permalink.