AW: Noch offen !!!
08.01.2007 10:33:00
Midgaardslang
Hallo,
habe es soweit doch allein geschafft, und nach 1 2 Problemen am Anfang läuft es sogar.
Hätte jetzt ein anderes, da ich den Code mal unten anfüge.
Kann ich ein Makro erstellen, das alle anderen ausführt, ohne das ich jedesmal alle aufrufen muss? Code is unten dran, Datei kann ich leider nicht hochladen, diese ist um die 4500 KByte groß. Außerdem will ich ja auch was Lernen, um nicht in 10 Tagen das gleiche zu fragen und nicht euch alle Arbeit machen lassen. Ich bin ja schon für deine geleistete Hilfe sehr dankbar @Bertram.
Sub TageAuszählenMoDoFrühjahr()
Dim zelle As Range
Dim intGelb As Integer
Dim intRot As Integer
Dim intGrün As Integer
Dim intRosa As Integer
Dim intGrau As Integer
intRot = 0
intGelb = 0
intGrün = 0
intRosa = 0
intGrau = 0
For Each zelle In Range("D8:L11,D19:L22,D30:J33").Cells
If zelle.Interior.ColorIndex = "6" Then intGelb = intGelb + 1
If zelle.Interior.ColorIndex = "3" Then intRot = intRot + 1
If zelle.Interior.ColorIndex = "43" Then intGrün = intGrün + 1
If zelle.Interior.ColorIndex = "15" Then intGrau = intGrau + 1
If zelle.Interior.ColorIndex = "7" Then intRosa = intRosa + 1
Next zelle
Range("P20").Value = intGrün
Range("P21").Value = intRot
Range("P22").Value = intGelb
Range("P23").Value = intGrau
Range("P24").Value = intRosa
End Sub
Sub TageAuszählenMoDoSommer()
Dim zelle As Range
Dim intGelb As Integer
Dim intRot As Integer
Dim intGrün As Integer
Dim intRosa As Integer
Dim intGrau As Integer
intRot = 0
intGelb = 0
intGrün = 0
intRosa = 0
intGrau = 0
For Each zelle In Range("L30:33,D42:L45,D53:L56,D64:L67,D76:L79,D87:L90,D98:L101").Cells
If zelle.Interior.ColorIndex = "6" Then intGelb = intGelb + 1
If zelle.Interior.ColorIndex = "3" Then intRot = intRot + 1
If zelle.Interior.ColorIndex = "43" Then intGrün = intGrün + 1
If zelle.Interior.ColorIndex = "15" Then intGrau = intGrau + 1
If zelle.Interior.ColorIndex = "7" Then intRosa = intRosa + 1
Next zelle
Range("T20").Value = intGrün
Range("T21").Value = intRot
Range("T22").Value = intGelb
Range("T23").Value = intGrau
Range("T24").Value = intRosa
End Sub
Sub TageAuszählenMoDoWinter()
Dim zelle As Range
Dim intGelb As Integer
Dim intRot As Integer
Dim intGrün As Integer
Dim intRosa As Integer
Dim intGrau As Integer
intRot = 0
intGelb = 0
intGrün = 0
intRosa = 0
intGrau = 0
For Each zelle In Range("D110:L113,D121:L124,D132:N135").Cells
If zelle.Interior.ColorIndex = "6" Then intGelb = intGelb + 1
If zelle.Interior.ColorIndex = "3" Then intRot = intRot + 1
If zelle.Interior.ColorIndex = "43" Then intGrün = intGrün + 1
If zelle.Interior.ColorIndex = "15" Then intGrau = intGrau + 1
If zelle.Interior.ColorIndex = "7" Then intRosa = intRosa + 1
Next zelle
Range("X20").Value = intGrün
Range("X21").Value = intRot
Range("X22").Value = intGelb
Range("X23").Value = intGrau
Range("X24").Value = intRosa
End Sub
Sub TageAuszählenFrFrühjahr()
Dim zelle As Range
Dim intGelb As Integer
Dim intRot As Integer
Dim intGrün As Integer
Dim intRosa As Integer
Dim intGrau As Integer
intRot = 0
intGelb = 0
intGrün = 0
intRosa = 0
intGrau = 0
For Each zelle In Range("D12:L12,D23:L23,D34:J34").Cells
If zelle.Interior.ColorIndex = "6" Then intGelb = intGelb + 1
If zelle.Interior.ColorIndex = "3" Then intRot = intRot + 1
If zelle.Interior.ColorIndex = "43" Then intGrün = intGrün + 1
If zelle.Interior.ColorIndex = "15" Then intGrau = intGrau + 1
If zelle.Interior.ColorIndex = "7" Then intRosa = intRosa + 1
Next zelle
Range("Q20").Value = intGrün
Range("Q21").Value = intRot
Range("Q22").Value = intGelb
Range("Q23").Value = intGrau
Range("Q24").Value = intRosa
End Sub
Sub TageAuszählenFrSommer()
Dim zelle As Range
Dim intGelb As Integer
Dim intRot As Integer
Dim intGrün As Integer
Dim intRosa As Integer
Dim intGrau As Integer
intRot = 0
intGelb = 0
intGrün = 0
intRosa = 0
intGrau = 0
For Each zelle In Range("L34,D46:L46,D57:L57,D68:L68,D80:L80,D91:L91,D102:L102").Cells
If zelle.Interior.ColorIndex = "6" Then intGelb = intGelb + 1
If zelle.Interior.ColorIndex = "3" Then intRot = intRot + 1
If zelle.Interior.ColorIndex = "43" Then intGrün = intGrün + 1
If zelle.Interior.ColorIndex = "15" Then intGrau = intGrau + 1
If zelle.Interior.ColorIndex = "7" Then intRosa = intRosa + 1
Next zelle
Range("U20").Value = intGrün
Range("U21").Value = intRot
Range("U22").Value = intGelb
Range("U23").Value = intGrau
Range("U24").Value = intRosa
End Sub
Sub TageAuszählenFrWinter()
Dim zelle As Range
Dim intGelb As Integer
Dim intRot As Integer
Dim intGrün As Integer
Dim intRosa As Integer
Dim intGrau As Integer
intRot = 0
intGelb = 0
intGrün = 0
intRosa = 0
intGrau = 0
For Each zelle In Range("D114:L114,D125:L125,D136:N136").Cells
If zelle.Interior.ColorIndex = "6" Then intGelb = intGelb + 1
If zelle.Interior.ColorIndex = "3" Then intRot = intRot + 1
If zelle.Interior.ColorIndex = "43" Then intGrün = intGrün + 1
If zelle.Interior.ColorIndex = "15" Then intGrau = intGrau + 1
If zelle.Interior.ColorIndex = "7" Then intRosa = intRosa + 1
Next zelle
Range("Y20").Value = intGrün
Range("Y21").Value = intRot
Range("Y22").Value = intGelb
Range("Y23").Value = intGrau
Range("Y24").Value = intRosa
End Sub