Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1328to1332
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

For-Each Schleife funktioniert nicht

For-Each Schleife funktioniert nicht
29.08.2013 19:01:29
TooX
Hallo Leute,
folgendes Problem; Ich habe eine For Each Schleife die an eine If Bedingung geknüpft ist. Jedes mal wenn er die If Bedingung durchläuft, springt er automatisch zur Else Bedingung und führt die darin befindliche Aktion aus. Könnte an dem Code eventuell etwas falsch sein?

Dim ProgressMarker As Range
For Each ProgressMarker In Sheets("Sheet").Range("A1:A9999").Cells
If ProgressMarker.Value = "X" Then
ProgressMarker.Select
Selection.Value = ""
Exit For
Else
Range("10:10").Select
Exit For
End If
Next

Wenn er einen Progress Marker gefunden hat soll er diesen selektieren und anschließend eine Zeile unter dem ProgressMarker eine vorher kopierte Zeile einfügen.
Leider springt er immer zur 10 Reihe und fügt dort die vorher kopierte Zeile ein.

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
ist schon richtig
29.08.2013 19:28:10
Erich
Hallo Vorname,
dein Code prüft nur, ob in der Zelle A1 ein großes X steht.
Ob dies der Fall ist oder nicht - die Schleife wird in beiden Fällen mit "Exit For" verlassen.
Das willst du sicher nicht.
Was du willst, geht aus deinem Beitrag nicht wirklich hervor.
Willst du oberhalb der ersten Zeile mit einem "X" in Spalte A eine Zeile einfügen?
Oder willst du oberhalb aller Zeilen mit einem "X" in Spalte A Zeilen einfügen?
Aus deinem Codefragment heraus kann man kaum sagen, wie man das richtig umsetzen könnte.
Jedenfalls sollte in dem Code das Wort "Select" nicht vorkommen...
Stattdessen kann man gleich Paste, Insert oder was immer du tun willst, schreiben.
Jetzt folgt in Gruß:
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Anzeige
Nachtrag
29.08.2013 19:39:36
TooX
Hallo,
Ich werde mal den Rest Code hinzufügen.

Dim ProgressMarker01 As Range
For Each ProgressMarker01 In Sheets("Sheet").Range("A1:A9999").Cells
If ProgressMarker01.Value = "X" Then
ProgressMarker01.Select
Selection.Value = ""
Exit For
Else
Range("10:10").Select
Exit For
End If
Next
If Sheets("Sheet2").Range("A1").Value = "ABC" Then
Sheets("Sheet3").Range("11:13").Copy
Selection.Offset(1, 0).Insert
End If
Selection.Value = ""
ActiveCell.Offset(3, 0).Select
Selection.Value = "X"
Sheets("Sheet2").Range("A2").Value = ""
Prinzipiell soll mir die Funktion sagen ob ein X vorhanden ist und wenn eines vorhanden sein sollte, dort hin springen und die kopierte Zeile aus Sheet3 eine Zeile darunter einzufügen. Wenn kein X vorhanden ist soll die kopierte Zeile eine Reihe unter Reihe 10 eingefügt werden.

Anzeige
AW: Nachtrag
29.08.2013 20:13:17
Raphael
Hallo TooX,
wie Erich schon gesagt hat, sind eigenlich alle Select nicht notwendig, um dir aber zu veranschaulichen warum dein Code immer die Zeile 10 markiert habe ich dir in deinem Code nochmal eines verbaut.
Kopiere ihn dir doch und führe ihn Schrittweis aus (das heisst, den Cursor irgendwo in die 5ub X() setzen und dann F8 drücken, jedesmal wenn du die F8 Taste drückst führt er die nächste Zeile deines Codes aus).
Sub x()
Dim ProgressMarker01 As Range
For Each ProgressMarker01 In Sheets("Sheet").Range("A1:A9999").Cells
ProgressMarker01.Select
If ProgressMarker01.Value = "X" Then
ProgressMarker01.Select
Selection.Value = ""
Exit For
Else
Range("10:10").Select
Exit For
End If
Next
If Sheets("Sheet2").Range("A1").Value = "ABC" Then
Sheets("Sheet3").Range("11:13").Copy
Selection.Offset(1, 0).Insert
End If
Selection.Value = ""
ActiveCell.Offset(3, 0).Select
Selection.Value = "X"
Sheets("Sheet2").Range("A2").Value = ""
End Sub
Nun kannst du dir überlegen wann er die Zeile 10 markieren soll und allenfalls den Code nochmals anpassen.
Mir hat es immer was gebracht wenn ich gesehen habe was genau mein Code in den Tabellenblättern tut.
Gruess
Raphael

Anzeige
AW: Nachtrag
29.08.2013 20:15:08
Gerd
Hi,
wieviele "X" kommen in Spalte A vor? Max. eines?
Mehrere? Soll dann mehrmals drunterkopiert werden?
Gruß zurück
Gerd

AW: Nachtrag
29.08.2013 20:19:36
TooX
Maximal kommt in Spalte A genau ein X vor, das immer nach jeder eingefügten Zeile gelöscht und unter die eingefügte Zeiele wieder reingeschrieben wird.

AW: Nachtrag
29.08.2013 20:57:04
fcs
Hallo toox,
es ist nur wenig klarer geworden. Ich verstehe es jetzt so:
1. Suche in Blatt "Sheet" in Spalte A ab Zeile 1 nach Zellinhalt "X"
2. Wenn Zelle mit "X" gefunden wird, dann ist die Einfügezeile unter der Zeile mit dem "X" sonst unter Zeile 10.
3. Wenn in Blatt "Sheet2" in Zelle A1 der Werte "ABC" steht dann:
- kopiere aus Blatt "Sheets3" die Zeilen 11 bis 13
- füge sie unter der Zeile mit dem "X" oder Zeile 10 ein
- Lösche das "X" bzw, den Inhalt von Zeile 10
- Füge 3 Zeilen unterhalb in Spalte A ein "X" ein.
- Lösche in Blatt "Sheet2" in Zelle A2 den Inhalt
Als Makro sieht das dann etwa wiefolgt aus.
Gruß
Franz
Sub ProcessMarker()
Dim rngCopy As Range, lngZeile As Long, wks As Worksheet
Dim ZeileZiel As Long
Set wks = Sheets("Sheet")
ZeileZiel = 10
With wks
For lngZeile = .Cells(.Rows.Count, 1).End(xlUp).Row To 1 Step -1
If UCase(.Cells(lngZeile, 1).Value) = "X" Then
ZeileZiel = lngZeile
Exit For
End If
Next lngZeile
If Sheets("sheet2").Range("A1") = "ABC" Then
Sheets("Sheet3").Rows("11:13").Copy
.Rows(ZeileZiel + 1).Insert Shift:=xlDown
Application.CutCopyMode = False
Sheets("sheet2").Range("A2") = ""
If ZeileZiel = 10 Then
.Rows(ZeileZiel).ClearContents      '?
Else
.Cells(ZeileZiel, 1).ClearContents ' X löschen
End If
.Cells(ZeileZiel + 3, 1) = "X"
Application.Goto Reference:=Sheets("Sheet").Cells(ZeileZiel + 3, 1)
End If
End With
End Sub

Anzeige
AW: Kommando - zurück neues Makro
29.08.2013 21:09:13
fcs
Hallo Toox,
nach deine letzten Erläuterungen . (Mehrere "X") muss man es anders lösen.
Gruß
Franz
Sub ProcessMarker()
Dim rngCopy As Range, lngZeile As Long, wks As Worksheet
Dim ZeileZiel As Long
Set wks = Sheets("Sheet")
ZeileZiel = 10
With wks
If Sheets("sheet2").Range("A1") = "ABC" Then
For lngZeile = .Cells(.Rows.Count, 1).End(xlUp).Row To 1 Step -1
If UCase(.Cells(lngZeile, 1).Value) = "X" Then
ZeileZiel = lngZeile
Sheets("Sheet3").Rows("11:13").Copy
.Rows(ZeileZiel + 1).Insert Shift:=xlDown
Application.CutCopyMode = False
.Cells(ZeileZiel, 1).ClearContents ' X löschen
End If
Next lngZeile
If ZeileZiel = 10 Then
Sheets("Sheet3").Rows("11:13").Copy
.Rows(ZeileZiel + 1).Insert Shift:=xlDown
Application.CutCopyMode = False
.Cells(ZeileZiel + 3, 1) = "X"    '?
End If
Else
MsgBox "nichts gemacht Wert in ""sheet2"" Zelle ""A1"" nicht = ""ABC"""
End If
End With
Sheets("sheet2").Range("A2") = ""
End Sub

Anzeige
AW: Ohne Schleife
29.08.2013 21:07:42
Gerd
Hallo,
noch ein Spielzeug.
Sub test()
Dim Quelle As Range
Dim Ziel As Range
If Sheets("Sheet2").Range("A1").Value = "ABC" Then
Set Quelle = Sheets("Sheet3").Range("11:13")
Set Ziel = Sheets("Sheet").Columns(1). _
Find("X", LookIn:=xlValues, lookat:=xlWhole, MatchCase:=True)
If Ziel Is Nothing Then
Set Ziel = Sheets("Sheet").Range("11:13")
Else
Ziel.ClearContents
Set Ziel = Ziel.Offset(1, 0).Resize(3, 1).EntireRow
End If
Ziel.Insert shift:=xlShiftDown
Quelle.Copy Destination:=Ziel
Ziel.Cells(1, 1).Offset(3, 0).ClearContents
Sheets("Sheet2").Range("A1").Value = ""
End If
End Sub
Gruß Gerd
Anzeige

305 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige