|
hier ein Versuch, ungetestet.
din Problem ist da du eine Range ddurchsuchst mit mehreren Zeilen und Spalten. Deine Schleife geht in der ersten Zeile nach rechts. Bleibt also in Zeile 14
Mein Vorschlag hat zwei For- Schleifen. Die Äußere geht zeilenweise durch die Range und die Innere in jeder Zeile durch die Spalten.
Sub SucheKalenderwoche()
Dim ws As Worksheet
Dim rng As Range
Dim cell As Range, rov As Range
Dim kalenderwoche As Long
Dim outputRow As Long, i&, colnr&
Set ws = ThisWorkbook.Sheets("Timingeins") ' Ersetze "DeinBlattName" durch den Namen deines Blatts
Set rng = ws.Range("14:21") ' Die zu überprüfende Zeile 14
outputRow = 50 ' Zeile, in der die Kalenderwochen ausgegeben werden sollen
colnr = 2
' Loop durch jede Zeile in der Range
For Each rov In rng.Rows
' Loop durch jede Zelle in der Zeile
For Each cell In rov
' Überprüfe die Farbe der Zelle (Blau - Farbcode 33)
If cell.Interior.Color = RGB(0, 176, 240) Then
' Gib den Text aus Zelle A14 in Zeile 50, Spalte A, aus
ws.Cells(outputRow, "A").Value = rov.Cells(1).Value
' Gib die ermittelte Kalenderwoche in der gewünschten Zeile aus (ab Zeile 50)
ws.Cells(outputRow, colnr).Value = ws.Cells(3, cell.Column).Value
colnr = colnr + 1 ' 1 Spalte nach rechts
End If
Next
' Inkrementiere die Ausgabezeile für die nächste gefundene Kalenderwoche
outputRow = outputRow + 1
Next
End Sub
|