Hallo Leute,
habe eine Tabelle die ich umformartieren muss.
Habe es mit Makro aufzeichnen versucht, jedoch ist die Tabelle sehr groß.
So wie folgt sieht es aus:
Sub Makro4()
’
’ Makro4 Makro
’ Makro am 13.08.2007 von MIR aufgezeichnet
’
’ Tastenkombination: Strg+t
’
Range(„B4:smiley:4“).Select
Selection.Cut Destination:=Range(„B3:smiley:3“)
Rows(„4:5“).Select
Selection.Delete Shift:=xlUp
Range(„B5:smiley:5“).Select
Selection.Cut Destination:=Range(„B4:smiley:4“)
Rows(„5:6“).Select
Selection.Delete Shift:=xlUp
Range(„B6:smiley:6“).Select
Selection.Cut Destination:=Range(„B5:smiley:5“)
Rows(„6:7“).Select
Selection.Delete Shift:=xlUp
End Sub
Wie kann ich das Makro jetzt erweitern bis zum Ende der Tabelle? Die Tabelle hat immerhin 318 Zeilen und davon habe ich 6 Tabellen, ich würde Ewigkeiten brauchen bis ich des gemacht hätte.
Vielen Dank schon einmal im Voruas für eure Hilfe.
Liebe Grüße
Lars
habe eine Tabelle die ich umformartieren muss.
Range(„B4:smiley:4“).Select
Selection.Cut Destination:=Range(„B3:smiley:3“)
Rows(„4:5“).Select
Selection.Delete Shift:=xlUp
Range(„B5:smiley:5“).Select
Selection.Cut Destination:=Range(„B4:smiley:4“)
Rows(„5:6“).Select
Selection.Delete Shift:=xlUp
Range(„B6:smiley:6“).Select
Selection.Cut Destination:=Range(„B5:smiley:5“)
Rows(„6:7“).Select
Selection.Delete Shift:=xlUp
Wie kann ich das Makro jetzt erweitern bis zum Ende der
Tabelle? Die Tabelle hat immerhin 318 Zeilen und davon habe
ich 6 Tabellen, ich würde Ewigkeiten brauchen bis ich des
gemacht hätte.
Hi Lars,
grundsätzlich, bei Zeilen löschen geht man von unten nach oben die Liste hoch. Ist einfacher und übersichtlicher.
Hab grad kein XL hier, völlig ungetestet:
Sub test()
Dim N, Zei
for N = 1 to 6
with worksheets(N)
For Zei=316 to 4 step -3 '-4 ?
.range("B" & Zei & ":smiley:" & Zei).copy destination:=.range("B" & Zei-1 & ":smiley:" & Zei-1)
.range("B" & Zei & ":smiley:" & Zei+2).entirerows.delete
next zei
end with
next N
end sub
Gruß
Reinhard
Hallo Reinhard,
erstmal vielen Dank für die schnelle Hilfe,
leider funzt das nicht.
Geht es nicht einfach irgendwie die u.g. Befehle auf die ganze Tabelle auszuweiten, dann wäre ich schon glücklich 
Vielen Dank nochmal im Voraus
[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]
Wie kann ich das Makro jetzt erweitern bis zum Ende der
Tabelle? Die Tabelle hat immerhin 318 Zeilen und davon habe
ich 6 Tabellen, ich würde Ewigkeiten brauchen bis ich des
gemacht hätte.
Hallo Lars
Ich hab da auch was rumgebastelt - nicht so professionell wie Reinhard! - So wie’s ausschaut, werden bei Dir die ersten beiden Zeilen nicht geändert. Gehören diese zwei zur Ueberschrift der Tabelle?
Ich habe Dein Makro etwas angepasst. Es wird ausgeführt, bis zur ersten leeren Zelle in der Spalte A.
Ich hoffe, es geschieht das, was Du willst. - Grüsse Niclaus
Sub Makro4a()
’
’ Makro4 Makro
’ Makro am 13.08.2007 von MIR aufgezeichnet
Range(„B4:smiley:4“).Select
Selection.Cut Destination:=Range(„B3:smiley:3“)
Rows(„4:5“).Select
Selection.Delete Shift:=xlUp
i = 1
While i 0
ActiveCell.Select: Selection.Range(„a1“).Select
Selection.Range(Cells(2, 2), Cells(2, 4)).Activate 'cells(z,sp)
Selection.Cut Destination:=ActiveCell.Offset(rowOffset:=-1, columnOffset:=0)
ActiveCell.Offset(rowOffset:=0, columnOffset:=-1).Activate
Selection.Range(„a1:a2“).EntireRow.Delete
ActiveCell.Select: Selection.Range(„a1“).Select
i = Selection.Range(„a1“)
Wend
End Sub
Hi Lars,
leider funzt das nicht.
Aha, ich liebe ausführliche Fehlerbeschreibungen.
Geht es nicht einfach irgendwie die u.g. Befehle auf die ganze
Tabelle auszuweiten, dann wäre ich schon glücklich
Genau das mache ich.
Tabelle? Die Tabelle hat immerhin 318 Zeilen und davon habe
ich 6 Tabellen, ich würde Ewigkeiten brauchen bis ich des
gemacht hätte.
Die Tabelle hat nicht 318 sondern 317 Zeilen mit diesem Aufbau, also 2 Kopfzeilen, dann 105 3er Blöcke.
Wobei pro 3er Block die mittlere Zeile in die obere Zeile kopiert wird und dann die mittlere und untere Zeile des 3er Blocks gelöscht wird.
Zumindest deute ich deinen Code so.
Getestet auf XL2000:
Sub test()
Dim N As Byte, Zei As Integer
For N = 1 To 6
With Worksheets(N)
For Zei = 315 To 3 Step -3
.Range("B" & Zei + 1 & ":smiley:" & Zei + 1).Copy Destination:=.Range("B" & Zei & ":smiley:" & Zei)
.Rows(Zei + 1 & ":" & Zei + 2).Delete
Next Zei
End With
Next N
End Sub
Gruß
Reinhard
Hallo Reinhard,
super, es hat funktioniert. Zwar nicht die ganze Tabelle aber zu 95% alles. Klasse, vielen Dank.
Fehler: Laufzeitfehler’9’ Index außerhalb des gültigen Bereichs
Wie speichert man ein Makro ab, damit man es beim nächsten Mal einfach nochmal starten kann?
Vielen Dank Reinhard
[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]
Hi Lars,
super, es hat funktioniert. Zwar nicht die ganze Tabelle aber
zu 95% alles. Klasse, vielen Dank.
dann ist die Tabelle nicht konsequent im Aufbau, 2 Kopfzeilen, dann immer 3er Blöcke nacheinander, aufgebaut.
Fehler: Laufzeitfehler’9’ Index außerhalb des gültigen
Bereichs
Vielleicht hast du keine 6 worksheets.
Wie speichert man ein Makro ab, damit man es beim nächsten Mal
einfach nochmal starten kann?
Extras—Makro–Aufzeichnen, dann wählst du als Speicherort „persönliche Arbeitsmappe“, zeichnest irgendwas völlig beliebiges auf, von A1 nach B1 kopiern o.ä., und beendest die Aufzeichnung.
Daraufhin hat Excel für dich eine personl.xls (personal.xls im engl. XL) erzeugt und sogar schon ein Modul1 wo der aufgezeichnte Code steht, denn löschst du halt.
In Modul1 dann deinen Code.
Gruß
Reinhard