Live-Forum - Die aktuellen Beiträge
Datum
Titel
18.04.2024 21:09:11
4 Spalten aus smarter Tabelle in andere smarte Tab. kopieren
18.04.2024 20:45:35
Worksheet_Activate für alle Sheets
18.04.2024 19:30:20
VBA - Tabelle mit Mannschaftsergebnissen sortieren
18.04.2024 18:04:29
Formel fehler Wert#
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1260to1264
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1260to1264
1260to1264
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Zahlschleife

Zahlschleife
Nils
Hallo zusammen,
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

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Zahlschleife
26.04.2012 11:30:23
Sheldon
Hi,
schreib mal so:
If Workbooks("ToDo_Listen_Verzeichnis.xlsx").Sheets("Rollenschneider").Cells(i, 9) = "im Plan" Then SummeiP = SummeiP + 1
statt
If Cells(i, 9) = "im Plan" Then SummeiP = SummeiP + 1
Abgesehen davon lässt du zweimal die Schleife auf jedem Blatt durchlaufen, dabei könntest du die beiden If-Bedingungen auch zusammenfassen und in einem Durchlauf unterbringen, etwa so:
For i = 2 To AnzahlZeilen
If Workbooks("ToDo_Listen_Verzeichnis.xlsx").Sheets("Rollenschneider").Cells(i, 9) = "im Plan" Then
SummeiP = SummeiP + 1
Elseif Workbooks("ToDo_Listen_Verzeichnis.xlsx").Sheets("Rollenschneider").Cells(i, 9) = "überschritten" Then
SummeÜ = SummeÜ + 1
End If
Next i
Gruß
Sheldon
Anzeige
AW: Zahlschleife
26.04.2012 13:26:27
Nils
Hallo Sheldon,
danke schön... War zwar jetzt recht simpel, aber unheimlich hilfreich.
Funktioniert jetzt bestens.
Gruß
Nils
AW: Zahlschleife
26.04.2012 13:46:25
fcs
Hallo Nils,
ergänzend zu Sheldons Hinweis.
Dadurch dass du die Blätter in der ToDo_Listen-Datei nicht aktivierst, werden ab dem 2. Blatt immer die Zellen im Blatt "Projektplan" ausgewertet, so dass immer 0 als Summenwerte ermittelt wird.
Du muss dafür sorgen, dass Excel immer auf die korrekten Zellen/Blätter zugreift. Dass geht am einfachsten mit Objektvariablen und Verwendung von With... End With.
sieht dann etwa wie folgt aus: 

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
Dim wbToDo As Workbook, wksToDo As Worksheet
Dim wbProjPlan As Workbook, wksProjPlan As Worksheet
Set wbProjPlan = Workbooks("Projektplan_Master.xlsm")
Set wksProjPlan = wbProjPlan.Sheets("Projektplan")
'Do To Listen Verzeichnis
Set wbToDo = Workbooks.Open( _
"F:\Group\Industrial Engineering\_Projektorganisation\ToDo_Listen_Verzeichnis.xlsx ")
'Allgemeines
With wbToDo.Sheets("Allgemeines")
Anzahlzeilen = .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
End With
Summe = SummeiP + SummeÜ
With wksProjPlan
.Range("A9") = Summe
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
End With
Anzahlzeilen = 0
Summe = 0
SummeiP = 0
SummeÜ = 0
Für die weiteren Blätter dann den Teil für "Allgemeines" wiederholen mit Anpassung von Blattname und Zielzeile im "Projektplan".
Gruß
Franz
P.S.: Wenn sich Vorgänge so systematisch wiederholen, dann sollte man hierfür eine Subroutine _ anlegen, an die die sich jeweils ändernden Werte als Parameter übergebn werden. Das Ganze wird so übersichtlicher und pflegeleichter. 

'Code in einem allgemeinen Modul
Option Explicit
Private wbToDo As Workbook, wksToDo As Worksheet
Private wbProjPlan As Workbook, wksProjPlan As Worksheet
Sub AnzahlTasks_kurz()
Set wbProjPlan = Workbooks("Projektplan_Master.xlsm")
Set wksProjPlan = wbProjPlan.Sheets("Projektplan")
'Do To Listen Verzeichnis
Set wbToDo = Workbooks.Open( _
"F:\Group\Industrial Engineering\_Projektorganisation\ToDo_Listen_Verzeichnis.xlsx ")
'Allgemeines
Call Auswerten(strBlatt:="Allgemeines", ZeileProjPlan:=9)
'Rollenschneider
Call Auswerten(strBlatt:="Rollenschneider", ZeileProjPlan:=10)
'Materialflussplanung
Call Auswerten(strBlatt:="Materialflussplanung", ZeileProjPlan:=11)
'Anströmschutz
Call Auswerten(strBlatt:="Anströmschutz", ZeileProjPlan:=8)
'IMS
Call Auswerten(strBlatt:="IMS", ZeileProjPlan:=15)
'Verstiftungsanlage
Call Auswerten(strBlatt:="Verstiftungsanlage", ZeileProjPlan:=18)
'VBU
Call Auswerten(strBlatt:="VBU", ZeileProjPlan:=16)
wbToDo.Close savechanges:=False
End Sub
Private Sub Auswerten(strBlatt As String, ZeileProjPlan As Long, _
Optional SpalteZeilen As Long = 9, _
Optional Zeile1 As Long = 2, _
Optional SpalteProjPlan As Long = 1, _
Optional lngColorIndex_1 As Long = 10, _
Optional lngColorIndex_2 As Long = 3, _
Optional lngColorIndex_3 As Long = 45)
'strBlatt = Name des tabellenblatts in dem gezählt werden soll
'ZeileProjPlan = Zielzeile in der Summenwert im "Projektplan" eingetragen werden soll
'SpalteZeilen  = Spalte im Blatt in der gezählt werden soll
'Zeile1        = 1. Zeile ab der gezählt werden soll
'SpalteProjPlan= Zielspalte in der Summenwert im "Projektplan" eingetragen werden soll
Dim Anzahlzeilen As Long
Dim Summe As Long, SummeiP As Long, SummeÜ As Long
With wbToDo.Sheets(strBlatt)
Anzahlzeilen = .Cells(Zeile1, SpalteZeilen).SpecialCells(xlCellTypeLastCell).Row
For i = Zeile1 To Anzahlzeilen
If .Cells(i, SpalteZeilen) = "im Plan" Then SummeiP = SummeiP + 1
If .Cells(i, SpalteZeilen) = "überschritten" Then SummeÜ = SummeÜ + 1
Next i
'i = i - 1
End With
Summe = SummeiP + SummeÜ
With wksProjPlan
With Cells(ZeileProjPlan, SpalteProjPlan)
.Value = Summe
If SummeiP >= 0 And SummeÜ = 0 Then
.Interior.ColorIndex = lngColorIndex_1
ElseIf SummeiP = 0 And SummeÜ >= 1 Then
.Interior.ColorIndex = lngColorIndex_2
ElseIf SummeiP >= 1 And SummeÜ >= 1 Then
.Interior.ColorIndex = lngColorIndex_3
Else
End If
End With
End With
End Sub

Anzeige
AW: Zahlschleife
26.04.2012 14:21:55
Nils
Hallo Franz,
da hast du recht, dadurch wird es übersichtlicher, besonders durch eine immer wachsende Anzahl an Tabellen die ich noch hinzufügen möchte.
Hast du vielleicht eine Idee, wie man das Hinzufügen solcher Tabellen inkl. Syntax automatisieren kann?
Damit meine ich, dass ich lediglich über Userform die benötigten Variablen füllen muss.
Ich habe da mal einen ANsatz verfolgt, bei dem ich allerdings eine Bibliothek freigeben musste, die ich nicht auf Servern laufen lassen kann, die von anderen Administratoren verwaltet werden.
Wenn dir hierzu nichts einfällt, trotzdem danke. Ihr habt mir beide sehr geholfen.
Gruß
NIls
Anzeige
AW: Zahlschleife
26.04.2012 15:53:09
fcs
Hallo Nils,
der einfachste Weg ist hier eine Liste auf einem separaten Tabellenlatt mit den Namen der abzuarbeitenden Tabellenblätter in Spalte A und den weiteren Parametern (wie Zielzeile im Projektplan, etc) in den weiteren Spalten.
Diese Liste kann man dann in einer For-Next-Schleife abarbeiten.
Auf ein Userform würde ich hier an deiner Stelle verzichten. Eine Liste mit ein paar Spalten an Informationen kann man doch auch so gut pflegen.
Für eine neue Tabelle trägst du die Informationen in eine leere Zeile ein. Anschliessend wird z.B. per Doppelklick_Ereignis in die Zelle mit dem Tabellennamen das Makro zum Einfügen des zusätzlichen Blattes gestartet.
Gruß
Franz
Anzeige

Links zu Excel-Dialogen

UserForm

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige