Probleme mit der Do und For Schleife ineinander

Sub Test2() Dim zz As Long Dim sAdr As String Dim i As Long Application.ScreenUpdating = False 'Das "Flackern" ausstellen Workbooks.Open Filename:="C:\Users\weber\Desktop\Datei2.xlsx" Windows("Datei1.xlsm").Activate Sheets("Test").Select For i = 1 To 5 For zz = 1 To 15 x = i If Cells(zz, 1) = x And _ Cells(zz, 3) = "Festwert" And _ Cells(zz, 2) "Du nicht" And _ Cells(zz, 2) "Du auch nicht Then sAdr = sAdr & "; " & Cells(zz, 2) End If Next zz Windows("Datei2.xlsx").Activate Sheets("Tabelle1").Select Cells(1, i) = Mid(sAdr, 3) Next i End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Weber,
... mit denen Du evtl. leichter zurechtkommst:
Variante A) entspricht am ehesten der von Dir gesuchten Vorgehensweise mit zwei Laufvariablen:

Sub a()
'Ausgangs-Arbeitsmappe = DIESE Arbeitsmappe (in der das Makro liegt)
Dim Wb As Workbook: Set Wb = ThisWorkbook
'Das Quell-Blatt bestimmen, hier Tabelle1, ggf. anpassen
Dim WsQ As Worksheet: Set WsQ = Wb.Worksheets("Tabelle1")
'Das Ziel-Blatt bestimmen, hier Tabelle2, ggf. anpassen
Dim WsZ As Worksheet: Set WsZ = Wb.Worksheets("Tabelle2")
'Zählvariablen und Text-Sammel-Variable deklarieren
Dim i As Long, j As Long, t As String
For i = 1 To 5 'Ziffern 1 - 5 in A:A
For j = 1 To 15 'Zeile 1 - 15
'Mit dem Quell-Blatt
With WsQ
If .Cells(j, 1) = i And _
.Cells(j, 3) = "Festwert" And _
.Cells(j, 2)  "Du nicht" And _
.Cells(j, 2)  "Du auch nicht" Then
t = t & .Cells(j, 2) & ";"
End If
End With
Next j 'Nächste Zeile
'Mit dem Ziel-Blatt
With WsZ
'In der nächsten freien Zelle der Zeile 1 den gesammelten
'Text eintragen (davon wird hinten ein Trennzeichen entfernt)
.Cells(1, .Columns.Count).End(xlToLeft).Offset(, 1) = _
Left(t, Len(t) - 1)
End With
'Die Text-Sammel-Variable leeren vor der nächsten PruefZiffer
t = vbNullString
Next i 'Nächste Ziffer in A:A
End Sub

Oder Variante B) die etwas flexibler ohne fixe Laufvariablen auskommt:

Sub b()
'Ausgangs-Arbeitsmappe = DIESE Arbeitsmappe (in der das Makro liegt)
Dim Wb As Workbook: Set Wb = ThisWorkbook
'Das Quell-Blatt bestimmen, hier Tabelle1, ggf. anpassen
Dim WsQ As Worksheet: Set WsQ = Wb.Worksheets("Tabelle1")
'Das Ziel-Blatt bestimmen, hier Tabelle2, ggf. anpassen
Dim WsZ As Worksheet: Set WsZ = Wb.Worksheets("Tabelle2")
'Die Liste und einzelne Zellen der Liste deklarieren
Dim Liste As Range, Eintrag As Range
'Sammlung an Prüfziffern aus Spalte A, Zähl-Variable und Text-Sammel-
'Variable deklarieren
Dim PruefZiffern, i As Long, t As String
'Sammlung an Ziffern, die in Spalte A geprüft werden, hier 1 bis 5
PruefZiffern = Array(1, 2, 3, 4, 5)
'Mit dem Quell-Blatt
With WsQ
'Den Bereich, der die zu kopierenden Zell-Texte enthält bestimmen
'Hier B1:Bx, wobei x gleich der letzten gefüllten Zelle in B:B entspricht
Set Liste = .Range(.Cells(1, 2), .Cells(.Rows.Count, 2).End(xlUp))
'Alle Elemente der o.a. PruefZiffern einzeln durchgehen...
For i = LBound(PruefZiffern) To UBound(PruefZiffern)
'Innerhalb jedes PruefZiffer-Durchlaufs
'jede Zelle der oben definierten Liste durchlaufen
For Each Eintrag In Liste
'Prüfungen:
'WENN die linke Zelle (Spalte A) die aktuelle PruefZiffer enthält
' UND wenn die rechte Zelle (Spalte C) "Festwert" enthält
'  UND wenn in der aktuellen Zelle der Liste weder "Du nicht" noch
'   "Du auch nicht steht"...
'DANN nimm den aktuellen Wert/Text der Zelle in eine Sammel-Variable auf
'zusammen mit einem Trennzeichen (hier ";")
If Eintrag.Offset(, -1) = PruefZiffern(i) And _
Eintrag.Offset(, 1) = "Festwert" And _
Eintrag  "Du nicht" And _
Eintrag  "Du auch nicht" Then
t = t & Eintrag & ";"
End If
Next Eintrag 'Nächste Zelle in der Liste (hier Spalte B)
'Mit dem Ziel-Blatt
With WsZ
'Die nächste freie Zelle bestimmen
'Hier die nächste freie Spalte in Zeile 1
'und den aktuellen Inhalt der Text-Sammel-Variablen dort eintragen
'Vom Text wird hinten ein Trennzeichen entfernt
.Cells(1, .Columns.Count).End(xlToLeft).Offset(, 1) = _
Left(t, Len(t) - 1)
End With
'Die Text-Sammel-Variable leeren vor der nächsten PruefZiffer
t = vbNullString
Next i
End With
End Sub

Habe Dir die Codes kommentiert, damit Du leichter nachvollziehen kannst, was da passiert. Kommst Du nun damit zurecht?
LG
Michael

Beliebteste Forumthreads (12 Monate)

Probleme mit der Do und For Schleife ineinander

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Probleme mit der Do und For Schleife ineinander

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread