Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
984to988
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
984to988
984to988
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Makro mit Schleife

Makro mit Schleife
19.06.2008 13:50:00
mehmet
Hallo Forum,
ich habe folgendes Makro aufgezeichnet:
...
Range("B12").Select: Selection.Cut Destination:=Range("A6")
Range("B13").Select: Selection.Cut Destination:=Range("B6")
Range("B14").Select: Selection.Cut Destination:=Range("C6")
Range("B15").Select: Selection.Cut Destination:=Range("D6")
Range("B16").Select: Selection.Cut Destination:=Range("E6")
Range("D12").Select: Selection.Cut Destination:=Range("F6")
Range("D13").Select: Selection.Cut Destination:=Range("G6")
Range("D14").Select: Selection.Cut Destination:=Range("H6")
Range("D15").Select: Selection.Cut Destination:=Range("I6")
Range("D16").Select: Selection.Cut Destination:=Range("J6")
Range("B17").Select: Selection.Cut Destination:=Range("A7")
Range("B18").Select: Selection.Cut Destination:=Range("B7")
Range("B19").Select: Selection.Cut Destination:=Range("C7")
Range("B20").Select: Selection.Cut Destination:=Range("D7")
Range("B21").Select: Selection.Cut Destination:=Range("E7")
Range("D17").Select: Selection.Cut Destination:=Range("F7")
Range("D18").Select: Selection.Cut Destination:=Range("G7")
Range("D19").Select: Selection.Cut Destination:=Range("H7")
Range("D20").Select: Selection.Cut Destination:=Range("I7")
Range("D21").Select: Selection.Cut Destination:=Range("J7")
Range("B22").Select: Selection.Cut Destination:=Range("A8")
Range("B23").Select: Selection.Cut Destination:=Range("B8")
Range("B24").Select: Selection.Cut Destination:=Range("C8")
Range("B25").Select: Selection.Cut Destination:=Range("D8")
Range("B26").Select: Selection.Cut Destination:=Range("E8")
Range("D22").Select: Selection.Cut Destination:=Range("F8")
Range("D23").Select: Selection.Cut Destination:=Range("G8")
Range("D24").Select: Selection.Cut Destination:=Range("H8")
Range("D25").Select: Selection.Cut Destination:=Range("I8")
Range("D26").Select: Selection.Cut Destination:=Range("J8")
Range("B27").Select: Selection.Cut Destination:=Range("A9")
Range("B28").Select: Selection.Cut Destination:=Range("B9")
Range("B29").Select: Selection.Cut Destination:=Range("C9")
Range("B30").Select: Selection.Cut Destination:=Range("D9")
Range("B31").Select: Selection.Cut Destination:=Range("E9")
Range("D27").Select: Selection.Cut Destination:=Range("F9")
Range("D28").Select: Selection.Cut Destination:=Range("G9")
Range("D29").Select: Selection.Cut Destination:=Range("H9")
Range("D30").Select: Selection.Cut Destination:=Range("I9")
Range("D31").Select: Selection.Cut Destination:=Range("J9")
Range("B32").Select: Selection.Cut Destination:=Range("A10")
Range("B33").Select: Selection.Cut Destination:=Range("B10")
Range("B34").Select: Selection.Cut Destination:=Range("C10")
Range("B35").Select: Selection.Cut Destination:=Range("D10")
Range("B36").Select: Selection.Cut Destination:=Range("E10")
Range("D32").Select: Selection.Cut Destination:=Range("F10")
Range("D33").Select: Selection.Cut Destination:=Range("G10")
Range("D34").Select: Selection.Cut Destination:=Range("H10")
Range("D35").Select: Selection.Cut Destination:=Range("I10")
Range("D36").Select: Selection.Cut Destination:=Range("J10")
Range("B12").Select: Selection.Cut Destination:=Range("A11")
Range("B13").Select: Selection.Cut Destination:=Range("B11")
Range("B14").Select: Selection.Cut Destination:=Range("C11")
Range("B15").Select: Selection.Cut Destination:=Range("D11")
Range("B16").Select: Selection.Cut Destination:=Range("E11")
Range("D12").Select: Selection.Cut Destination:=Range("F11")
Range("D13").Select: Selection.Cut Destination:=Range("G11")
Range("D14").Select: Selection.Cut Destination:=Range("H11")
Range("D15").Select: Selection.Cut Destination:=Range("I11")
Range("D16").Select: Selection.Cut Destination:=Range("J11")
Range("B17").Select: Selection.Cut Destination:=Range("A12")
Range("B18").Select: Selection.Cut Destination:=Range("B12")
Range("B19").Select: Selection.Cut Destination:=Range("C12")
Range("B20").Select: Selection.Cut Destination:=Range("D12")
Range("B21").Select: Selection.Cut Destination:=Range("E12")
Range("D17").Select: Selection.Cut Destination:=Range("F12")
Range("D18").Select: Selection.Cut Destination:=Range("G12")
Range("D19").Select: Selection.Cut Destination:=Range("H12")
Range("D20").Select: Selection.Cut Destination:=Range("I12")
Range("D21").Select: Selection.Cut Destination:=Range("J12")
Range("B22").Select: Selection.Cut Destination:=Range("A13")
Range("B23").Select: Selection.Cut Destination:=Range("B13")
Range("B24").Select: Selection.Cut Destination:=Range("C13")
Range("B25").Select: Selection.Cut Destination:=Range("D13")
Range("B26").Select: Selection.Cut Destination:=Range("E13")
Range("D22").Select: Selection.Cut Destination:=Range("F13")
Range("D23").Select: Selection.Cut Destination:=Range("G13")
Range("D24").Select: Selection.Cut Destination:=Range("H13")
Range("D25").Select: Selection.Cut Destination:=Range("I13")
Range("D26").Select: Selection.Cut Destination:=Range("J13")
Range("B27").Select: Selection.Cut Destination:=Range("A14")
Range("B28").Select: Selection.Cut Destination:=Range("B14")
Range("B29").Select: Selection.Cut Destination:=Range("C14")
Range("B30").Select: Selection.Cut Destination:=Range("D14")
Range("B31").Select: Selection.Cut Destination:=Range("E14")
Range("D27").Select: Selection.Cut Destination:=Range("F14")
Range("D28").Select: Selection.Cut Destination:=Range("G14")
Range("D29").Select: Selection.Cut Destination:=Range("H14")
Range("D30").Select: Selection.Cut Destination:=Range("I14")
Range("D31").Select: Selection.Cut Destination:=Range("J14")
Range("B32").Select: Selection.Cut Destination:=Range("A15")
Range("B33").Select: Selection.Cut Destination:=Range("B15")
Range("B34").Select: Selection.Cut Destination:=Range("C15")
Range("B35").Select: Selection.Cut Destination:=Range("D15")
Range("B36").Select: Selection.Cut Destination:=Range("E15")
Range("D32").Select: Selection.Cut Destination:=Range("F15")
Range("D33").Select: Selection.Cut Destination:=Range("G15")
Range("D34").Select: Selection.Cut Destination:=Range("H15")
Range("D35").Select: Selection.Cut Destination:=Range("I15")
Range("D36").Select: Selection.Cut Destination:=Range("J15")
Wie kann ich dies als eine Schleife realisieren?
Dank und Gruss
Mehmet

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro mit Schleife
Ramses
Hallo
das hast du SOO nicht aufgezeichnet und ergibt auch keinen Sinn
Range("B12").Select: Selection.Cut Destination:=Range("A6")
Range("B12").Select: Selection.Cut Destination:=Range("A11")
Was du schon ausgeschnitten hast, kannst nicht nochmal ausschneiden,... das ergibt keinen Sinn weil die Zellen dann leer sind
Für die erste Hälfte deines Makros sollte dies funktionieren
Option Explicit

Sub Trans4C()
Dim i As Long, n As Long
Dim startR As Long, tarR As Long
startR = 12
tarR = 6
For i = startR To 32 Step 5
Cells(i, 2).Cut Destination:=Cells(tarR, 1)
Cells(i, 4).Cut Destination:=Cells(tarR, 5)
tarR = tarR + 1
Next i
End Sub


Gruss Rainer
Gruss Rainer

Anzeige
AW: Makro mit Schleife
19.06.2008 14:28:55
Uwe
Hi Mehmet,
ich bin mal wieder langsamer als Rainer und habe auch eine unständlichere Lösung. Außerdem habe ich mit Copy und Paste.Special / Transpose gearbeitet, da ich Dein Cut irgendwie nicht bemerkt habe. Mit Cut klappt Paste.Special natürlich nicht (:-(. Da müsste man den kopierten Bereich im Nachhinein noch löschen.
Aber da, wie Rainer bemerkt hat, sowieso etwas unklar an Deiner Aufzeichnung ist, zeige ich meinen Code trotzdem mal. Vielleicht kannst Du Ihn ja anpassen. Sonst ignorier diesen Beitrag einfach:

Sub test()
Dim H As Integer
Dim i As Integer
For H = 0 To 5 Step 5
For i = 0 To 4
Range(cells(12 + i * 5, 2), cells(16 + i * 5, 2)).Copy
cells(6 + i + H, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range(cells(12 + i * 5, 4), cells(16 + i * 5, 4)).Copy
cells(6 + i + H, 6).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Next i
Next H
End Sub


Gruß
Uwe
(:o)

Anzeige
AW: Makro mit Schleife
19.06.2008 14:20:00
Rudi
Hallo,

Sub tt()
Dim i As Integer
For i = 6 To 15
Range(Cells(i, 1), Cells(i, 5)) = _
WorksheetFunction.Transpose(Range(Cells(i * 5 - 18, 2), Cells(i * 5 - 18 + 4, 2)))
Range(Cells(i * 5 - 18, 2), Cells(i * 5 - 18 + 4, 2)).ClearContents
Range(Cells(i, 6), Cells(i, 10)) = _
WorksheetFunction.Transpose(Range(Cells(i * 5 - 18, 4), Cells(i * 5 - 18 + 4, 4)))
Range(Cells(i * 5 - 18, 4), Cells(i * 5 - 18 + 4, 4)).ClearContents
Next i
End Sub


Das doppelte Ausschneiden hat Rainer ja schon bemängelt.
Gruß
Rudi

AW: Makro mit Schleife
19.06.2008 14:30:00
fcs
Hallo Mehmet,
z.B. so:

Sub aaUmgruppieren()
Dim wks As Worksheet
Dim ZeileQ As Long, ZeileD As Long, Spalte As Long
Set wks = ActiveSheet
ZeileD = 6
With wks
For ZeileQ = 12 To 36 Step 5
For Spalte = 1 To 5
'Werte aus Spalte B in Zielzeile verschieben
.Cells(ZeileQ + Spalte - 1, 2).Cut Destination:=.Cells(ZeileD, Spalte)
'Werte aus Spalte D in Zielzeile verschieben
.Cells(ZeileQ + Spalte - 1, 4).Cut Destination:=.Cells(ZeileD, Spalte + 5)
Next Spalte
ZeileD = ZeileD + 1
Next ZeileQ
End With
End Sub

Gruß
Franz

Anzeige
AW: Makro mit Schleife
19.06.2008 14:45:05
mehmet
Ihr seid alle Toll und natürlich schneller als ich,
ich Danke euch für den Ansatz.
Den Makro habe ich aufgezeichnet. Natürlich kommt da meinchmal was komisches raus 8-)
Im Editor wollte ich ein bisschen übersicht verschaffen.
Es handelt sich um eine Webabfrage.
Die Tabelle ist nach dem Download so aufgebaut:
https://www.herber.de/bbs/user/53203.xls
Ich wollte jetzt eigendlich hier die Tabelle, tabellarisch darstellen:
A5= SeqNo:, B5=Published, C5=WEF, D5=UNT, E5=Flight Level,
F5=FMP, G5=FMP, H5=Sate, I5=Regulation Id, J5=Reason und K5=Traf. Vol. Desc.
Natürlich währe es super, wenn die ganze Tabelle Umsortiert werden.
Ich habe die Tabelle farblich markiert, um es besser Darzustellen.
Gruss
Mehmet

Anzeige
AW: Makro mit Schleife
19.06.2008 16:09:12
fcs
Hallo Mehmet,
da die Daten teileweise unregelmäßig sind mit einer Extra-Zeile ist das Ganze jetzt koplizierter.
Der Einfachheit wegen werden die Daten jetzt in eine neues Tabellenblatt kopiert und Die Spalten ein wenig formatiert.
Gruß
Franz

Sub aaUmgruppieren()
Dim wks As Worksheet, wksZiel As Worksheet
Dim ZeileQ As Long, ZeileD As Long, Spalte As Long
Set wks = ActiveSheet
ZeileD = 5 'Starzeile für Zieldaten
ZeileQ = 7 'Starzeile für Quelldaten
Application.ScreenUpdating = False
Worksheets.Add after:=Sheets(1) 'Neues Sheet einfügen
Set wksZiel = ActiveSheet
With wks
'Datum und Released kopieren
.Range("a1:B2").Copy Destination:=wksZiel.Range("A1")
'Spaltentitel Kopieren
For Spalte = 1 To 5
'Werte aus Spalte A in Zielzeile verschieben
.Cells(ZeileQ + Spalte - 1, 1).Copy Destination:=wksZiel.Cells(5, Spalte)
'Werte aus Spalte C in Zielzeile verschieben
.Cells(ZeileQ + Spalte - 1, 3).Copy Destination:=wksZiel.Cells(ZeileD, Spalte + 5)
Next Spalte
'daten kopieren
Do Until ZeileQ > .Cells(.Rows.Count, 1).End(xlUp).Row
ZeileD = ZeileD + 1
Do Until .Cells(ZeileQ, 1) = "Seq No:" Or ZeileQ > .Cells(.Rows.Count, 1).End(xlUp).Row
wksZiel.Cells(ZeileD - 1, 10) = wksZiel.Cells(ZeileD - 1, 10) & .Cells(ZeileQ, 1)
ZeileQ = ZeileQ + 1
Loop
For Spalte = 1 To 5
'Werte aus Spalte B in Zielzeile verschieben
.Cells(ZeileQ + Spalte - 1, 2).Copy Destination:=wksZiel.Cells(ZeileD, Spalte)
'Werte aus Spalte D in Zielzeile verschieben
.Cells(ZeileQ + Spalte - 1, 4).Copy Destination:=wksZiel.Cells(ZeileD, Spalte + 5)
Next Spalte
ZeileQ = ZeileQ + 5
Loop
End With
'Zieltabelle formatieren
With wksZiel
.Cells.VerticalAlignment = xlVAlignTop
.Columns("A:I").AutoFit
.Columns("J:J").ColumnWidth = 40
.Columns("J:J").WrapText = True
Application.ScreenUpdating = True
.Range("A6").Select
ActiveWindow.FreezePanes = True
End With
End Sub


Anzeige
Franz, du bist Super.Es funktioniert.Dank dir o.T.
19.06.2008 17:02:20
mehmet
.

eine Frage noch bitte
19.06.2008 17:16:35
mehmet
Hallo Franz,
muss man den ein neues Sheet einfügen.
Dank deiner Komentation könnte ich kleinigkeiten ändern:
' Worksheets.Add after:=Sheets(1) 'Neues Sheet einfügen
Worksheets.Add.Name = "cfmu" 'Neues Sheet einfügen
Jetzt bekomme ich zwar den Sheet hin mit einer Benennung, allerding funktioniert der Makro nicht mehr, wenn ich ein Update fahre.
Ich würde gern den Aktiven Sheet bennen und bei jedem update soll es diesen Sheet überschreiben.
Dank und Gruss
Mehmet

AW: eine Frage noch bitte
19.06.2008 17:20:18
mehmet
Hallo Franz,
man könnte ja ein Temp-Sheet einfügen,
die Daten in Temp-Sheet saugen und später den Temp-Sheet löschen.
Könnte es funktionieren?
Gruss
Mehmet

Anzeige
AW: eine Frage noch bitte
19.06.2008 17:41:21
mehmet
Ich hab es geschaft 8-)
Herzliche Grüsse.
Mehmet

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige