Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1156to1160
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
Inhaltsverzeichnis

In For each rng weiterspringen

In For each rng weiterspringen
Gregor
Hallo zusammen
Ich suche nach einer Zellfarbe. Die Zeile dieser Zelle wird dann bis zu 15 Zeilen erweitert und kopiert (eruiert erste und letzte zu kopierende Zeile). Anschliessend muss die Suche dieser Zellfarbe nach der kopierten Zeile weiterfahren, ansonsten werden die gleichen Zeilen mehrmals kopiert. Ich versuchte es mit folgendem Makro, der rng-Bereich wird aber nicht angepasst sondern geht Zelle um Zelle weiter. Wie kann ich das lösen?
Zeile = 6
With Worksheets(Tabellenblatt)
For Each rng In .Range(.Cells(Zeile, Spalte_Überlänge), .Cells(intLastRow, Spalte_Überlänge))
If rng.Interior.ColorIndex = Farbcode Then
Zeile = rng.Row
If IsEmpty(.Cells(Zeile, 1)) And IsEmpty(.Cells(Zeile, 2)) = True Then
Zeile = .Cells(Zeile, 1).End(xlUp).Row
End If
ZeileEnd = IIf(IsEmpty(.Cells(Zeile + 1, 1)), IIf(IsEmpty(.Cells(.Cells(Zeile, 1).End(xlDown).Row - 1, Spalte_Nutzlänge)), .Cells(.Cells(Zeile, 1).End(xlDown).Row, Spalte_Nutzlänge).End(xlUp).Row, .Cells(Zeile, 1).End(xlDown).Row - 1), Zeile)
'--- bestimmt letzte Zeile Tabelle zum Einfügen
intLastRowPaste = Worksheets(Blattname).Cells(Rows.Count, Spalte_Nutzlänge).End(xlUp).Row + 1
'--- Kopierbereich
Set Kopieren = .Range(.Cells(Zeile, 1), .Cells(ZeileEnd, intLastColumn))
'--- Zielbereich
Set Ziel = Worksheets(Blattname).Cells(intLastRowPaste, 1)
Kopieren.Copy Ziel
Zeile = ZeileEnd + 1
End If
Next
End With
Vielen Dank
Gregor

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: In For each rng weiterspringen
18.05.2010 11:00:44
David
Hallo Gregor,
baue die Schleife nach dem Muster "For i=x to y", wobei du natürlich die entsprechenden Werte für x und y entweder vorgeben musst (falls sie fest sind) oder entsprechend ermitteln lassen musst (so wie du ja den Range auch schon jetzt ermittelst).
Wenn dann dein Kopiercode greift, fügst du am Ende ein i=i+zzz ein, wobei dann zzz für die Anzahl der kopierten Zeilen steht (die entweder auch fest ist oder die du im Code ermitteln musst).
Wenn dann die Codezeile Next kommt, ist dann das i schon entsprechend weiter und arbeitet die betreffenden Zeilen nicht mehr mit ab.
Gruß
David
Anzeige
AW: In For each rng weiterspringen
18.05.2010 11:29:28
Gregor
Hoi David
Vielen Dank für die Unterstützung. Wenn ich dich richtig verstanden habe, sieht mein Code jetzt so aus:
With Worksheets(Tabellenblatt)
For Zeile = 6 To intLastRow
For Each rng In .Range(.Cells(Zeile, Spalte_Überlänge), .Cells(intLastRow, Spalte_Überlänge))
If rng.Interior.ColorIndex = Farbcode Then
Zeile = rng.Row
'--- prüfen, ob eruierte Zeile der obersten Zeile Bahnhof entspricht
If IsEmpty(.Cells(Zeile, 1)) And IsEmpty(.Cells(Zeile, 2)) = True Then
Zeile = .Cells(Zeile, 1).End(xlUp).Row
End If
ZeileEnd = IIf(IsEmpty(.Cells(Zeile + 1, 1)), IIf(IsEmpty(.Cells(.Cells(Zeile, 1).End(xlDown).Row - 1, Spalte_Nutzlänge)), .Cells(.Cells(Zeile, 1).End(xlDown).Row, Spalte_Nutzlänge).End(xlUp).Row, .Cells(Zeile, 1).End(xlDown).Row - 1), Zeile)
'--- bestimmt letzte Zeile Tabelle zum Einfügen
intLastRowPaste = Worksheets(Blattname).Cells(Rows.Count, Spalte_Nutzlänge).End(xlUp).Row + 1
'--- Kopierbereich
Set Kopieren = .Range(.Cells(Zeile, 1), .Cells(ZeileEnd, intLastColumn))
'--- Zielbereich
Set Ziel = Worksheets(Blattname).Cells(intLastRowPaste, 1)
Kopieren.Copy Ziel
Zeile = ZeileEnd
Exit For
End If
Next
Application.StatusBar = "Fortschrittskontrolle: " & intLastRow - ZeileEnd
Next Zeile
End With
Auf jeden Fall funktionierts. Ich denke, dass ist die schnellste Variante.
Gruss Gregor
Anzeige
AW: In For each rng weiterspringen
18.05.2010 11:43:29
David
Hallo Gregor,
der Code ist in dieser Darstellung sehr schwer zu lesen, deswegen steige ich da nicht tiefer ein. Aber wenn es funzt, sollte das dann so passen.
Ob es die schnellste Variante ist, kann ich nicht sagen, mein VBA-Level ist auch nur "bescheiden". Ist sicher auch abhängig davon, auf wieviel Daten du den Code loslässt. Solltest du Performance-Probleme haben, hilft es oft schon ausreichend, diverse "Beschleunigungsfunktionen" ein/auszuschalten. Ich mache das meist so (auch mal vor langer Zeit hier im Forum gefunden):
Als zusätzliches Makro in der Mappe:
Sub GetMoreSpeed(bYesNo As Boolean)
Application.ScreenUpdating = Not (bYesNo)
Application.EnableEvents = Not (bYesNo)
Application.Calculation = IIf(bYesNo, xlCalculationManual, xlCalculationAutomatic)
If Not bYesNo Then Calculate
End Sub

Innerhalb deines Codes dann dann mit Getmorespeed True am Anfang den "Turbo" anschalten und vor dem End Sub dann mit Getmorespeed False wieder aus.
Wichtig ist dann nur, beim Debuggen darauf zu achten, dass durch Unterbrechungen nicht noch irgendeine Option auf False steht und dann weitere Fehler produziert, deswegen diese "Beschleunigung" erst einbauen/einschalten, wenn der Code an sich reibungslos läuft.
Gruß
David
Anzeige

303 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige