Schleifenproblem
13.07.2003 15:46:21
Björn
In der Spalte A soll ab der Zelle A4 geprüft werden, ob diese leer sind. Für die Zellen, die einen Inhalt haben, soll nachfolgend beschriebener Vorgang ablaufen, und sobald festgestellt wird, dass die nächste Zelle in Spalte A leer ist, soll der nachfolgend beschriebene Vorgang abgebrochen werden.
Für jede Zelle in Spalte A mit einem Inhalt soll nun Folgendes gemacht werden:
Ab der 3 ten Zelle bis zu einer definierten Zelle in der jeweiligen Spalte neben der jeweiligen als voll geprüften Zelle soll nun geprüft werden, ob auch hier ein Inhalt vorhanden ist. Wenn ein Inhalt vorhanden ist, soll
1. der Inhalt der jeweiligen Zelle der Spalte A auch in der gleichen Zelle in dem Tabellenblatt2 erscheinen.
2. der Inhalt der jeweiligen Zelle der Spalte B auch in der gleichen Zelle in dem Tabellenblatt2 erscheinen.
3. der Inhalt der jeweiligen Zelle der Spalte d.column auch in der gleichen Zelle in dem Tabellenblatt2 erscheinen, wobei der Wert zuvor durch den Wert der jeweiligen Zelle der Spalte 2 geteilt werden soll.
Ich hab nun das Problem, dass nur in der letzten Zeile, wo eine volle Zelle gefunden wurde die Übertragung und das Rechnen funktioniert.
Ich hoffe ich hab das Problem gut genug beschrieben.
Vielen Dank für die Hilfe
Björn
Private Sub CommandButton2_Click()
Dim c As Range
Dim d As Range
Dim laR1 As Long, laR2 As Long
laR1 = Cells(Rows.Count, 1).End(xlUp).Row
If laR1 < 4 Then Exit Sub
For Each c In Range("A4:A" & laR1 + 1)
If c.Value = "" Then
laR2 = c.Row
For Each d In Range(Cells(laR2 - 1, 3), Cells(laR2 - 1, 38))
If IsEmpty(d.Value) = False Then
Sheets("Tabelle2").Cells(laR2 - 1, 1) = Cells(laR2 - 1, 1)
Sheets("Tabelle2").Cells(laR2 - 1, 2) = Cells(laR2 - 1, 2)
Sheets("Tabelle2").Cells(laR2 - 1, d.Column) = d.Value / Cells(laR2 - 1, 2)
Sheets("Tabelle2").PageSetup.PrintArea = "$A$1:$Al$" & laR2 - 1
Else
Exit For
End If
Next d
Exit For
End If
Next c
End Sub