Live-Forum - Die aktuellen Beiträge
Datum
Titel
20.04.2024 00:49:19
Excel Sheet in einen Excel Kalender einfügen
20.04.2024 00:08:11
In Ordner nur das Speichern von Dateien erlauben
19.04.2024 21:26:15
mehrfache Texte finden
19.04.2024 19:41:34
Bei VBA Ausführung Anzeige einfrieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
712to716
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
712to716
712to716
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Schleife bauen

Schleife bauen
23.12.2005 09:39:24
Ellen
Hallo,
kann man für folgenden Code eine Schleife bauen? Sonst muß ich das Macro ewig von Hand weiterschreiben.
Merkmale:
- in SHIPMENT ADMIN NAT wird immer eine Zeile nach unten gegangen, start bei A11 -> A12,A13,A14....
- Es wird immer Bereich Zeile 2 bis 24 kopiert und zwar nach Zeile 62 -> dann 122,182,242..... also immer 60 Zeilen weiter
- die Zeile in der eingetragen wird verschiebt sich auch immer um 60 Zeilen
- die Zelle in der im SHIMPENT ADMIN NAT gesucht wird verschiebt sich immer um eine nach unten: 11 -> 12,13,14.....
Hier der Code, den ich gerne als Schleife hätte:

Sub go()
' If 2 Boxes -> 2nd Box Address Label
Sheets("SHIPMENT ADMIN NAT").Select
If Not Range("A11") = "" Then
Sheets("Box Address Label").Select
Rows("2:24").Copy
Rows("62:62").Select
ActiveSheet.Paste
Worksheets("Box Address Label").Cells(63, 5).Value = Worksheets("SHIPMENT ADMIN NAT").Cells(11, 2).Value
Worksheets("Box Address Label").Cells(68, 6).Value = Worksheets("SHIPMENT ADMIN NAT").Cells(11, 6).Value
Range("A1").Select
Application.CutCopyMode = False
End If
' If 3 Boxes -> 3rd Box Address Label
Sheets("SHIPMENT ADMIN NAT").Select
If Not Range("A12") = "" Then
Sheets("Box Address Label").Select
Rows("2:24").Copy
Rows("122:122").Select
ActiveSheet.Paste
Worksheets("Box Address Label").Cells(123, 5).Value = Worksheets("SHIPMENT ADMIN NAT").Cells(12, 2).Value
Worksheets("Box Address Label").Cells(128, 6).Value = Worksheets("SHIPMENT ADMIN NAT").Cells(12, 6).Value
Range("A1").Select
Application.CutCopyMode = False
End If
' If 4 Boxes -> 4th Box Address Label
Sheets("SHIPMENT ADMIN NAT").Select
If Not Range("A13") = "" Then
Sheets("Box Address Label").Select
Rows("2:24").Copy
Rows("182:182").Select
ActiveSheet.Paste
Worksheets("Box Address Label").Cells(183, 5).Value = Worksheets("SHIPMENT ADMIN NAT").Cells(13, 2).Value
Worksheets("Box Address Label").Cells(188, 6).Value = Worksheets("SHIPMENT ADMIN NAT").Cells(13, 6).Value
Range("A1").Select
Application.CutCopyMode = False
End If
' If 5 Boxes -> 5th Box Address Label
Sheets("SHIPMENT ADMIN NAT").Select
If Not Range("A14") = "" Then
Sheets("Box Address Label").Select
Rows("2:24").Copy
Rows("242:242").Select
ActiveSheet.Paste
Worksheets("Box Address Label").Cells(243, 5).Value = Worksheets("SHIPMENT ADMIN NAT").Cells(14, 2).Value
Worksheets("Box Address Label").Cells(248, 6).Value = Worksheets("SHIPMENT ADMIN NAT").Cells(14, 6).Value
Range("A1").Select
Application.CutCopyMode = False
End If
' If 6 Boxes -> 6th Box Address Label
Sheets("SHIPMENT ADMIN NAT").Select
If Not Range("A15") = "" Then
Sheets("Box Address Label").Select
Rows("2:24").Copy
Rows("302:302").Select
ActiveSheet.Paste
Worksheets("Box Address Label").Cells(303, 5).Value = Worksheets("SHIPMENT ADMIN NAT").Cells(15, 2).Value
Worksheets("Box Address Label").Cells(308, 6).Value = Worksheets("SHIPMENT ADMIN NAT").Cells(15, 6).Value
Range("A1").Select
Application.CutCopyMode = False
End If
' If 7 Boxes -> 7th Box Address Label
Sheets("SHIPMENT ADMIN NAT").Select
If Not Range("A16") = "" Then
Sheets("Box Address Label").Select
Rows("2:24").Copy
Rows("362:362").Select
ActiveSheet.Paste
Worksheets("Box Address Label").Cells(363, 5).Value = Worksheets("SHIPMENT ADMIN NAT").Cells(16, 2).Value
Worksheets("Box Address Label").Cells(368, 6).Value = Worksheets("SHIPMENT ADMIN NAT").Cells(16, 6).Value
Range("A1").Select
Application.CutCopyMode = False
End If
' If 8 Boxes -> 8th Box Address Label
Sheets("SHIPMENT ADMIN NAT").Select
If Not Range("A17") = "" Then
Sheets("Box Address Label").Select
Rows("2:24").Copy
Rows("422:422").Select
ActiveSheet.Paste
Worksheets("Box Address Label").Cells(423, 5).Value = Worksheets("SHIPMENT ADMIN NAT").Cells(17, 2).Value
Worksheets("Box Address Label").Cells(428, 6).Value = Worksheets("SHIPMENT ADMIN NAT").Cells(17, 6).Value
Range("A1").Select
Application.CutCopyMode = False
End If
End Sub

Vielen Dank im Voraus.
Gruß,
Ellen

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Schleife bauen
23.12.2005 10:19:02
Eugen
hi
sollte so gehen, aber nicht getestet
public 

Sub go()
for i = 11 to 65535
' das Abbruch kriterium
if Sheets("SHIPMENT ADMIN DAT").Cells(i,1).Value = "" then exit for
Sheets("Box Address Label").Select
rows(2,24).select
rows(i*60 + 2).select
ActiveSheet.Paste
Worksheets("Box Address Label").Cells(i*60+3, 5).Value = Worksheets("SHIPMENT ADMIN NAT").Cells(i, 2).Value
Worksheets("Box Address Label").Cells(i*60+8, 6).Value = Worksheets("SHIPMENT ADMIN NAT").Cells(i, 6).Value
Range("A1").Select
Application.CutCopyMode = False
Next i
End Sub

mfg
Anzeige
AW: Schleife bauen
23.12.2005 10:29:24
Ellen
Hallo Eugen,
danke für deine Idee, leider funktioniert das Macro nicht. Ich habe ein paar Kleinigkeiten geändert, dass es so aussieht:

Sub test()
For i = 11 To 65535
' das Abbruch kriterium
If Sheets("SHIPMENT ADMIN NAT").Cells(i, 1).Value = "" Then Exit For
Sheets("Box Address Label").Select
Rows("2:24").Select
Selection.Copy
Rows(i + 60 + 2).Select
ActiveSheet.Paste
Worksheets("Box Address Label").Cells(i + 60 + 3, 5).Value = Worksheets("SHIPMENT ADMIN NAT").Cells(i, 2).Value
Worksheets("Box Address Label").Cells(i + 60 + 8, 6).Value = Worksheets("SHIPMENT ADMIN NAT").Cells(i, 6).Value
Range("A1").Select
Application.CutCopyMode = False
Next i
End Sub

Jedoch stimmt die Position nicht ganz wo das Label 2 eingefügt wird und bei 3 Labels geht es nicht mehr weiter.
Hier ein Testfile: https://www.herber.de/bbs/user/29510.xls
Gruß,
Ellen
Anzeige
AW: Schleife bauen
23.12.2005 10:39:46
Hajo_Zi
Hallo Ellen,
in Deinem Code finde ich keine Zeile wo einb Label eingefügt wird.In VBA kann zu 99% auf select usw. verzichtet werden.

Sub test()
If Sheets("SHIPMENT ADMIN NAT").Cells(i, 1).Value <> "" Then
For i = 11 To 65535
' das Abbruch kriterium
Sheets("Box Address Label").Rows("2:24").Copy _
Destination:=Rows(i + 60 + 2)
Worksheets("Box Address Label").Cells(i + 60 + 3, 5).Value = _
Worksheets("SHIPMENT ADMIN NAT").Cells(i, 2).Value
Worksheets("Box Address Label").Cells(i + 60 + 8, 6).Value = _
Worksheets("SHIPMENT ADMIN NAT").Cells(i, 6).Value
Next i
End If
End Sub



Anzeige
AW: Schleife bauen
23.12.2005 10:46:59
Ellen
Hallo Hajo,
sorry mein Fehler, das mit dem Label hat mit dem Tabellenblatt Box Address Label zu tun, wenn man meine Datei ansieht: https://www.herber.de/bbs/user/29510.xls
Wenn in Tabellenblatt SHIPMENT ADMIN NAT 2 Datensätze sind wird Bereich 2:24 (Box Address Label) kopiert und ein zweites erstellt, 3 Datensätze -> 3 Labels,....
Mit dem Select bin ich noch nicht so sicher wann und wann nicht.
Der erste Bereich des Makros passt, bis hier hin:

Sub test()
Rows(i + 60 + 2).Select
ActiveSheet.Paste
Worksheets("Box Address Label").Cells(i + 60 + 3, 5).Value = Worksheets("SHIPMENT ADMIN NAT").Cells(i, 2).Value
Worksheets("Box Address Label").Cells(i + 60 + 8, 6).Value = Worksheets("SHIPMENT ADMIN NAT").Cells(i, 6).Value
End Sub

Das kann nicht passen, da i z.B. Zeile 11 von Tabellenblatt SHIPMENT ADMIN NAT ist und in Tabellenblatt Box Address Label kann dann nicht i+60+3,5 sein.
Es wäre nett wenn jemand helfen könnte, vielleicht meine ursprüngliche Beschreibung und Testfile ansehen. Danke.
Gruß,
Ellen
Anzeige
gelöst ;-)
23.12.2005 11:02:36
Ellen
Danke für eure zahlreiche Hilfe, hab's nun so gelöst:

Sub test()
x = 62
For i = 11 To 65535
' das Abbruch kriterium
If Sheets("SHIPMENT ADMIN NAT").Cells(i, 1).Value = "" Then Exit For
Sheets("Box Address Label").Select
Rows("2:24").Copy
Rows(x).Select
ActiveSheet.Paste
Worksheets("Box Address Label").Cells(x + 1, 5).Value = Worksheets("SHIPMENT ADMIN NAT").Cells(i, 2).Value
Worksheets("Box Address Label").Cells(x + 6, 6).Value = Worksheets("SHIPMENT ADMIN NAT").Cells(i, 6).Value
Range("A1").Select
Application.CutCopyMode = False
x = x + 60
Next i
End Sub

Gruß,
Ellen
Anzeige
AW: Schleife bauen
23.12.2005 10:22:51
alex
hey Ellen,
hab zwar heut bis 6 in der früh gefeiert aber dass könnte dir vielleicht helfen.
ich lös solche probleme immer mit einer laufvariable
dim i
for i = 1 to 10 'wie oft du halt willst
'code und statt den fixen bereichen wie "a11" musst du dann "a" & 10 + i
'oder statt ("62:62") halt (2 + i * 60 & ":" & 2 + i * 60) schreiben
next i
so in der art wirds gehen, aber ich garantiere für nix bei meinem kater kann ich sowieso nicht arbeiten.
wenn dir jemand deinen code fertig schreibt wär ich ihm sehr dankbar
gruss alex
AW: Schleife bauen
23.12.2005 10:38:17
Ellen
Hallo Alex,
mit Sicherheit ein guter Ansatz, leider kann ich es nicht umändern, bekomme nur Fehlermeldungen beim Kompilieren. Wahrscheinlich muß ich noch etwas beachten, aber ich bekomme das nicht hin.
Gruß,
Ellen
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige