Zahlschleife
Nils
ich habe mir eine Reihe von Schleifen gebastelt, die eine Spalte durchlaufen hochzählen wenn ein bestimmter Text in einer Zelle geschrieben steht. Dadurch, dass ich zwei verschiedene Begriffe suche habe ich auch zwei Schleifen gebastelt, deren Ergnisse ich später addiere.
Dieses Vorgehen habe ich für weitere Tabellen, die ebenfalls durchsucht werden sollen einfach kopiert.
Merkwürdig ist, dass es für eine Tabelle wunderbar funktioniert hat und mit der Erweiterung durch weitere Tabellen nicht mehr.
Ich habe von der ersten Tabelle zwar einen Ausgabewert, der allerdings nicht korrekt ist. Für die folgenden Tabellen wird mir immer 0 ausgegeben.
Das ist alle sehrmerkwürdig, da ich über F8 ja nachvollziehen kann was in der Prozedur gerade passiert und da funktioniert die If-Abfrage in der Schleife nicht. Wenn der Wert vorhanden ist, springt der nicht in den 'then' Befehl.
Bitte bitte, Hilfe!
Option Explicit
Sub AnzahlTasks()
Dim AnzahlZeilen As Integer
Dim AnzahlImPlan As Integer
Dim AnzahlÜberschritten As Integer
Dim SummeiP As Integer
Dim SummeÜ As Integer
Dim i As Integer
Dim Summe As Integer
Dim Colour As Range
'Do To Listen Verzeichnis
'Allgemeines
Workbooks.Open ("F:\Group\Industrial Engineering\_Projektorganisation\ToDo_Listen_Verzeichnis. _
xlsx")
AnzahlZeilen = Workbooks("ToDo_Listen_Verzeichnis.xlsx").Sheets("Allgemeines").Cells(2, 9). _
SpecialCells(xlCellTypeLastCell).Row
For i = 2 To AnzahlZeilen
If Cells(i, 9) = "im Plan" Then SummeiP = SummeiP + 1 'Exit For
'End If
Next i
For i = 2 To AnzahlZeilen
If Cells(i, 9) = "überschritten" Then SummeÜ = SummeÜ + 1 'Exit For
'End If
Next i
'i = i - 1
Summe = SummeiP + SummeÜ
Workbooks("Projektplan_Master.xlsm").Sheets("Projektplan").Range("A9") = Summe
Workbooks("Projektplan_Master.xlsm").Sheets("Projektplan").Activate
If SummeiP >= 0 And SummeÜ = 0 Then
Cells(9, 1).Interior.ColorIndex = 10
ElseIf SummeiP = 0 And SummeÜ >= 1 Then
Cells(9, 1).Interior.ColorIndex = 3
ElseIf SummeiP >= 1 And SummeÜ >= 1 Then
Cells(9, 1).Interior.ColorIndex = 45
Else
End If
AnzahlZeilen = 0
Summe = 0
SummeiP = 0
SummeÜ = 0
'Rollenschneider
AnzahlZeilen = Workbooks("ToDo_Listen_Verzeichnis.xlsx").Sheets("Rollenschneider").Cells(2, 9). _
SpecialCells(xlCellTypeLastCell).Row
For i = 2 To AnzahlZeilen
If Cells(i, 9) = "im Plan" Then SummeiP = SummeiP + 1 'Exit For
'End If
Next i
For i = 2 To AnzahlZeilen
If Cells(i, 9) = "überschritten" Then SummeÜ = SummeÜ + 1 'Exit For
'End If
Next i
'i = i - 1
Summe = SummeiP + SummeÜ
Workbooks("Projektplan_Master.xlsm").Sheets("Projektplan").Range("A10") = Summe
Workbooks("Projektplan_Master.xlsm").Sheets("Projektplan").Activate
If SummeiP >= 0 And SummeÜ = 0 Then
Cells(10, 1).Interior.ColorIndex = 10
ElseIf SummeiP = 0 And SummeÜ >= 1 Then
Cells(10, 1).Interior.ColorIndex = 3
ElseIf SummeiP >= 1 And SummeÜ >= 1 Then
Cells(10, 1).Interior.ColorIndex = 45
Else
End If
AnzahlZeilen = 0
Summe = 0
SummeiP = 0
SummeÜ = 0
'Materialflussplanung
AnzahlZeilen = Workbooks("ToDo_Listen_Verzeichnis.xlsx").Sheets("Materialflussplanung").Cells(2, _
9).SpecialCells(xlCellTypeLastCell).Row
For i = 2 To AnzahlZeilen
If Cells(i, 9) = "im Plan" Then SummeiP = SummeiP + 1 'Exit For
'End If
Next i
For i = 2 To AnzahlZeilen
If Cells(i, 9) = "überschritten" Then SummeÜ = SummeÜ + 1 'Exit For
'End If
Next i
'i = i - 1
Summe = SummeiP + SummeÜ
Workbooks("Projektplan_Master.xlsm").Sheets("Projektplan").Range("A11") = Summe
Workbooks("Projektplan_Master.xlsm").Sheets("Projektplan").Activate
If SummeiP >= 0 And SummeÜ = 0 Then
Cells(11, 1).Interior.ColorIndex = 10
ElseIf SummeiP = 0 And SummeÜ >= 1 Then
Cells(11, 1).Interior.ColorIndex = 3
ElseIf SummeiP >= 1 And SummeÜ >= 1 Then
Cells(11, 1).Interior.ColorIndex = 45
Else
End If
AnzahlZeilen = 0
Summe = 0
SummeiP = 0
SummeÜ = 0
'Anströmschutz
AnzahlZeilen = Workbooks("ToDo_Listen_Verzeichnis.xlsx").Sheets("Anströmschutz").Cells(2, 9). _
SpecialCells(xlCellTypeLastCell).Row
For i = 2 To AnzahlZeilen
If Cells(i, 9) = "im Plan" Then SummeiP = SummeiP + 1 'Exit For
'End If
Next i
For i = 2 To AnzahlZeilen
If Cells(i, 9) = "überschritten" Then SummeÜ = SummeÜ + 1 'Exit For
'End If
Next i
'i = i - 1
Summe = SummeiP + SummeÜ
Workbooks("Projektplan_Master.xlsm").Sheets("Projektplan").Range("A8") = Summe
Workbooks("Projektplan_Master.xlsm").Sheets("Projektplan").Activate
If SummeiP >= 0 And SummeÜ = 0 Then
Cells(8, 1).Interior.ColorIndex = 10
ElseIf SummeiP = 0 And SummeÜ >= 1 Then
Cells(8, 1).Interior.ColorIndex = 3
ElseIf SummeiP >= 1 And SummeÜ >= 1 Then
Cells(8, 1).Interior.ColorIndex = 45
Else
End If
AnzahlZeilen = 0
Summe = 0
SummeiP = 0
SummeÜ = 0
'IMS
AnzahlZeilen = Workbooks("ToDo_Listen_Verzeichnis.xlsx").Sheets("IMS").Cells(2, 9).SpecialCells( _
xlCellTypeLastCell).Row
For i = 2 To AnzahlZeilen
If Cells(i, 9) = "im Plan" Then SummeiP = SummeiP + 1 'Exit For
'End If
Next i
For i = 2 To AnzahlZeilen
If Cells(i, 9) = "überschritten" Then SummeÜ = SummeÜ + 1 'Exit For
'End If
Next i
'i = i - 1
Summe = SummeiP + SummeÜ
Workbooks("Projektplan_Master.xlsm").Sheets("Projektplan").Range("A15") = Summe
Workbooks("Projektplan_Master.xlsm").Sheets("Projektplan").Activate
If SummeiP >= 0 And SummeÜ = 0 Then
Cells(15, 1).Interior.ColorIndex = 10
ElseIf SummeiP = 0 And SummeÜ >= 1 Then
Cells(15, 1).Interior.ColorIndex = 3
ElseIf SummeiP >= 1 And SummeÜ >= 1 Then
Cells(15, 1).Interior.ColorIndex = 45
Else
End If
AnzahlZeilen = 0
Summe = 0
SummeiP = 0
SummeÜ = 0
'Verstiftungsanlage
AnzahlZeilen = Workbooks("ToDo_Listen_Verzeichnis.xlsx").Sheets("Verstiftungsanlage").Cells(2, _
9).SpecialCells(xlCellTypeLastCell).Row
For i = 2 To AnzahlZeilen
If Cells(i, 9) = "im Plan" Then SummeiP = SummeiP + 1 'Exit For
'End If
Next i
For i = 2 To AnzahlZeilen
If Cells(i, 9) = "überschritten" Then SummeÜ = SummeÜ + 1 'Exit For
'End If
Next i
'i = i - 1
Summe = SummeiP + SummeÜ
Workbooks("Projektplan_Master.xlsm").Sheets("Projektplan").Range("A18") = Summe
Workbooks("Projektplan_Master.xlsm").Sheets("Projektplan").Activate
If SummeiP >= 0 And SummeÜ = 0 Then
Cells(18, 1).Interior.ColorIndex = 10
ElseIf SummeiP = 0 And SummeÜ >= 1 Then
Cells(18, 1).Interior.ColorIndex = 3
ElseIf SummeiP >= 1 And SummeÜ >= 1 Then
Cells(18, 1).Interior.ColorIndex = 45
Else
End If
AnzahlZeilen = 0
Summe = 0
SummeiP = 0
SummeÜ = 0
'VBU
AnzahlZeilen = Workbooks("ToDo_Listen_Verzeichnis.xlsx").Sheets("VBU").Cells(2, 9).SpecialCells( _
xlCellTypeLastCell).Row
For i = 2 To AnzahlZeilen
If Cells(i, 9) = "im Plan" Then SummeiP = SummeiP + 1 'Exit For
'End If
Next i
For i = 2 To AnzahlZeilen
If Cells(i, 9) = "überschritten" Then SummeÜ = SummeÜ + 1 'Exit For
'End If
Next i
'i = i - 1
Summe = SummeiP + SummeÜ
Workbooks("Projektplan_Master.xlsm").Sheets("Projektplan").Range("A16") = Summe
Workbooks("Projektplan_Master.xlsm").Sheets("Projektplan").Activate
If SummeiP >= 0 And SummeÜ = 0 Then
Cells(16, 1).Interior.ColorIndex = 10
ElseIf SummeiP = 0 And SummeÜ >= 1 Then
Cells(16, 1).Interior.ColorIndex = 3
ElseIf SummeiP >= 1 And SummeÜ >= 1 Then
Cells(16, 1).Interior.ColorIndex = 45
Else
End If
AnzahlZeilen = 0
Summe = 0
SummeiP = 0
SummeÜ = 0
Workbooks("ToDo_Listen_Verzeichnis.xlsx").Close (False)
End Sub