Else ohne IF
14.08.2018 10:49:44
Björn
Sub Lardis()
Dim colTabelle As Collection
Dim colZeile As Collection
Set colTabelle = New Collection
For Z = 2 To 150
Set colZeile = New Collection
For T = 1 To 4
If ActiveSheet.Cells(T, Z).Value False Then
If ActiveSheet.Cells(5, Z).Value False Then
With colZeile
.Add Z - 1, "Zähler"
.Add ActiveSheet.Cells(5, Z).Value, "Einsatzkräfte"
.Add "26" & Left(ActiveSheet.Cells(T, Z).Value, 3), "Schleifen"
.Add "51", "51"
.Add Mid(ActiveSheet.Cells(T, Z).Value, 4), "Zusatzinfo"
Else
With colZeile
.Add Z - 1, "Zähler"
.Add "Frei", "Einsatzkräfte"
.Add "26" & Left(ActiveSheet.Cells(T, Z).Value, 3), "Schleifen"
.Add "51", "51"
.Add Mid(ActiveSheet.Cells(T, Z).Value, 4), "Zusatzinfo"
End If
Next T
colTabelle.Add colZeile
Next Z
With ThisWorkbook
.Sheets.Add after:=Sheets(Worksheets.Count)
.ActiveSheet.Name = "Lardis"
End With
ActiveWorkbook.Sheets("Lardis").Select
For Zeile = 1 To colTabelle.Count
For Spalte = 1 To 4
ActiveSheet.Cells(Zeile, Spalte) = colTabelle(Zeile)(Spalte)
Next Spalte
Next Zeile
With ThisWorkbook
.Sheets.Add after:=Sheets(Worksheets.Count)
.ActiveSheet.Name = "Schliefen Liste"
End With
ActiveWorkbook.Sheets("Schleifen Liste").Select
For Zeile = 1 To colTabelle.Count
For Spalte = 1 To 5
ActiveSheet.Cells(Zeile, Spalte) = colTabelle(Zeile)(Spalte)
Next Spalte
Next Zeile
End Sub