PDA

Vollständige Version anzeigen : For-each-Schleife läuft nur einmal durch


Vigo2
28.06.2014, 19:34
Hallo zusammen!

Kann mir jemand helfen und mir sagen, wieso meine Schleife für par="TAG" und par="DI" nur jeweils einmal durchläuft?

Sub xy()

Dim wkshinter As Worksheet
Dim wkshilf As Worksheet
Dim h As Long
Dim lest As Long
Dim llest As Long
Dim par As Variant
Dim qar As Variant
Dim rar As Variant
Dim zelle1 As Variant
Dim erstezelle As String, xxyAdresse As String
Dim xxy As Range

Set wkshinter = Worksheets("Hintergrundtabelle")
Set wkshilf = Worksheets("Hilfstabelle")

With wkshinter
lest = Sheets("Hintergrundtabelle").Cells(Rows.Count, 6).End(xlUp).Row
If lest < 2 Then lest = 2
End With

With wkshilf
llest = Sheets("Hilfstabelle").Cells(Rows.Count, 2).End(xlUp).Row
If llest < 2 Then llest = 2
End With

With wkshinter
h = 1
For Each zelle1 In .Range("F2:F" & .Cells(Rows.Count, 6).End(xlUp).Row)
h = h + 1
par = wkshinter.Cells(h, 6).Value
qar = wkshinter.Cells(h, 6).Offset(0, -2).Value
rar = -qar
If par = "TAG" Then
With wkshilf
.Range(Cells(llest, 2), Cells(llest, 21)) = "x"
End With
ElseIf par = "DI" Then
With Worksheets("Hilfstabelle").Range(Cells(1, 2), Cells(1, 21))
Set xxy = .Find(what:="Di", LookIn:=xlValues)
If Not xxy Is Nothing Then
erstezelle = xxy.Address
Do Until xxyAdresse = erstezelle
xxy.Offset(llest, 0).Value = "x"
Set xxy = .FindNext(xxy)
xxyAdresse = xxy.Address
Loop
End If
End With
End If
lest = Sheets("Hilfstabelle").Cells(Rows.Count, 2).End(xlUp).Row + 1
Next zelle1
End With

End Sub


Viele Grüße, Vigo2

pefeu
28.06.2014, 20:34
Hallo Vigo,

ich würde es einmal mit Dim Zelle1 As Range versuchen und dann
mit For Each zelle1 In .Range("F2:F" & .Cells(.Rows.Count, 6).End(xlUp).Row) einem Punkt vor Rows.Count

Wenn das nicht die Lösung ist, solltest Du zusätzlich den Inhlat von
.Cells(.Rows.Count, 6).End(xlUp).Row prüfen.

Gruß Peter

Vigo2
28.06.2014, 20:47
Hallo Peter!

Danke für deine Tipps!
Leider ändern die Tipps nichts daran, dass jeweils immer nur eine Ausgabe für par="TAG" und par="DI" angezeigt wird.

Ich hab schon versucht anstelle eines variablen Bereichs
(For Each zelle1 In .Range("F2:F" & .Cells(Rows.Count, 6).End(xlUp).Row))

eines festen Bereich einzugeben(in diesem Beispiel: For Each zelle1 In .Range("F2:F74")

Hat leider nichts geändert... Achso, und ja ich hab mich schon versichert, dass ich mich auf das richtige Tabellenblatt und die richtige Spalte bezogen habe.

Viele Grüße, Vigo

EarlFred
28.06.2014, 21:01
Hallo Vigo,

schau mal genau hin:
.Range(Cells(llest, 2), Cells(llest, 21))
auf was bezieht sich .Range()?
auf was bezieht sich Cells()?
Schau auf den Punkt. Fehlerquelle!

Der Code ist miserabel lesbar. Rücke erstmal alles gleichmäßig ein, was einen Block ergibt. Dann siehst Du salbest viel schneller, was zusammen gehört.

Dein For-Each-Konstrukt in Verbindung mit wkshinter.Cells(h, 6) ist sinnlos, da dies ja genau Zelle1 entspricht.

Schleife für par="TAG" und par="DI"
Ich verstehe nichtmal die Frage. Ich sehe nur eine For-Each-Schleife und eine Do-Loop-Schleife. Beide bringe ich nicht in Verbindung mit der Frage.
Warum sollte denn die Do-Loop-Schleife überhaupt mehrfach durchlaufen werden? Ändert sich am Ergebnis doch eh nichts mehr nach dem ersten Durchlauf? Oder muss man dafür die Mappe kennen, um den Sinn zu verstehen?

Eine Mustermappe wäre wirklich sinnvoll, zusammen mit einer überarbeiteten Fragestellung, die auch verständlich ist.

Den Sinn dieses Blocks (und analog des nachfolgenden) verstehe ich auch nicht:
With wkshinter
lest = Sheets("Hintergrundtabelle").Cells(Rows.Count, 6).End(xlUp).Row
If lest < 2 Then lest = 2
End With

Grüße
EarlFred

Vigo2
29.06.2014, 10:06
Hallo zusammen!

Ich hab eine Beispielmappe erstellt und meinen Code "aufgeräumt".
Den Code findet ihr in der Mappe im Modul1.

@ EarlFred: ich hab versucht, die Sachen, auf die du eingegangen bist, zu berücksichtigen. Allerdings konnte ich dennoch nicht beheben, dass die Schleife jeweils nur einmal durchlaufen wird. Hast du eine Idee wieso das nicht läuft?

Viele Grüße, Vigo2

aloys78
29.06.2014, 10:26
Hallo Vigo,

folgende Zeile habe ich geändert:
llest = Sheets("Hilfstabelle").Cells(Rows.Count, 2).End(xlUp).Row + 1
Next zelle1
End With

Gruß
Aloys

Vigo2
29.06.2014, 10:40
Hallo Aloys!

Oh ja, stimmt das hab ich falsch gemacht!
Nun führt der Code das komplett durch für zelle1="TAG" (insgesamt 31 mal, stimmt soweit!)
Das wars dann aber auch! Wieso macht er das nicht für zelle1="DI"?

aloys78
29.06.2014, 11:31
Hallo Vigo,

dann probier mal den nachfolgenden Code:

Gruß
Aloys

Option Explicit

Sub xy()

Dim wkshinter As Worksheet
Dim wkshilf As Worksheet
Dim lest As Long
Dim llest As Long
Dim zelle1 As Range
Dim erstezelle As String, xxyAdresse As String
Dim xxy As Range
Set wkshinter = Worksheets("Hintergrundtabelle")
Set wkshilf = Worksheets("Hilfstabelle")

With wkshinter
lest = Sheets("Hintergrundtabelle").Cells(Rows.Count, 6).End(xlUp).Row 'ermittelt letzte Zeile im Tabellenblatt wkshinter ab Zeile 2 bis Ende
If lest < 2 Then lest = 2
End With

llest = 1

With wkshinter
For Each zelle1 In .Range("F2:F" & lest)
If zelle1.Value = "TAG" Then
With wkshilf
llest = llest + 1
.Range(.Cells(llest, 2), .Cells(llest, 21)) = "x"
End With
ElseIf zelle1.Value = "DI" Then
With Worksheets("Hilfstabelle").Range(Cells(1, 2), Cells(1, 21))
Set xxy = .Find(what:="Di", LookIn:=xlValues, LookAt:=xlWhole)
If Not xxy Is Nothing Then
erstezelle = xxy.Address
llest = llest + 1
Do
xxy.Offset(llest - 1, 0).Value = "x"
Set xxy = .FindNext(xxy)
xxyAdresse = xxy.Address
Loop While Not xxy Is Nothing And xxyAdresse <> erstezelle
End If
End With
End If
Next zelle1
End With

End Sub

Vigo2
29.06.2014, 12:01
Das ist der Code! Funktioniert super!
Nicht zu glauben, dass ein "llest" einem so viel Ärger bereiten kann!
Vielen, vielen Dank für deine Geduld und Mühe, Aloys!!!

Viele Grüße, Vigo2