Ich habe eine Formel die mir in einem Bereich die Datum zählt, jedoch ohne jene die doppelt sind:
{=SUMME(WENN(JAHR(C16:M500)=D2;1/ZÄHLENWENN(C16:M500;C16:M500);0))}
kann man das auch per vba lösen?
Liebe Grüsse
Sascha
Sub ZählenDatumfürJahr()
Dim dicDat As Object
Dim arr, a
Dim Jahr As Long
Set dicDat = CreateObject("Scripting.Dictionary")
arr = Range("c16:m500").Value
Jahr = Range("D2").Value
For Each a In arr
If IsDate(a) Then
If Year(a) = Jahr Then dicDat(a) = 1
End If
Next
MsgBox "Anzahl Datumswerte für " & Jahr & ": " & dicDat.Count
End Sub
Ein DictionaryObjekt ist im Prinzip ein Eindimensionales Array mit einem Freitext-Index.
Sub ZählenDatumfürJahr()
Dim dicDat As Object
Dim arr, a
Dim Jahr As Long
Set dicDat = CreateObject("Scripting.Dictionary")
arr = Range("A1:A500").Value
Jahr = Range("D2").Value
For Each a In arr
If arr.Interior.Color = RGB(194, 214, 154) And Year(arr) = Sheets("Kostenkontrolle").Range("C2") _
And IsDate(a) Then
If Year(a) = Jahr Then dicDat(a) = 1
End If
Next
MsgBox "Anzahl Datumswerte für " & Jahr & ": " & dicDat.Count
End Sub
aber ich komme nicht weiter
Sub ZählenDatumfürJahr()
Dim dicDat As Object
Dim c As Range
Dim Jahr As Long
Set dicDat = CreateObject("Scripting.Dictionary")
Jahr = Sheets("Kostenkontrolle").Range("C2").Value
For Each c In Range("A1:A500").Cells
If IsDate(c.Value) Then
If Year(c.Value) = Jahr Then
If c.Interior.Color = RGB(194, 214, 154) Then
dicDat(a) = 1
End If
End If
End If
Next
MsgBox "Anzahl Datumswerte für " & Jahr & ": " & dicDat.Count
End Sub
Sub ZählenDatumfürJahr1()
Dim dicDat As Object
Dim c As Range
Dim Jahr As Long
Set dicDat = CreateObject("Scripting.Dictionary")
Jahr = Range("D2").Value
For Each c In Range("A1:A10").Cells
If IsDate(c.Value) Then
If Year(c.Value) = Jahr Then
If c.Interior.Color = RGB(194, 214, 154) Then
dicDat(c) = 1
End If
End If
End If
Next
MsgBox dicDat.Count
End Sub
Aber nun zählt es mir einfach alle die die Farbe haben, aber auch die doppelten
Sub ZählenDatumfürJahr1()
Dim dicDat As Object
Dim c As Range
Dim Jahr As Long
Set dicDat = CreateObject("Scripting.Dictionary")
Jahr = Range("D2").Value
For Each c In Range("C16:M500").Cells
If c.Interior.Color = Range("I3").Interior.Color Then
If IsDate(c.Value) Then
If Year(c.Value) = Jahr Then
dicDat(c) = 1
End If
End If
End If
Next
MsgBox dicDat.Count
End Sub
Sub ZählenDatumfürJahr1()
Dim dicDat As Object
Dim c As Range
Dim Jahr As Long
Set dicDat = CreateObject("Scripting.Dictionary")
Jahr = Sheets("Kostenkontrolle").Range("C2").Value
For Each c In Range("C16:M500").Cells
If c.Interior.Color = Sheets("Kostenkontrolle").Range("I3").Interior.Color Then
If IsDate(c.Value) Then
If Year(c.Value) = Jahr Then
dicDat(c.Value) = 1
End If
End If
End If
Next
Sheets("Kostenkontrolle").Range("B9") = dicDat.Count
End Sub
und hier mein Code für 12 Monate:Sub Lektionen_Mirjam() 'Lektionen mirjam pro Monat und Jahr
Dim c As Range
Dim Jahr As Long
Dim dicDat1 As Object
Dim dicDat2 As Object
Dim dicDat3 As Object
Dim dicDat4 As Object
Dim dicDat5 As Object
Dim dicDat6 As Object
Dim dicDat7 As Object
Dim dicDat8 As Object
Dim dicDat9 As Object
Dim dicDat10 As Object
Dim dicDat11 As Object
Dim dicDat12 As Object
Dim monat1 As Long
Dim monat2 As Long
Dim monat3 As Long
Dim monat4 As Long
Dim monat5 As Long
Dim monat6 As Long
Dim monat7 As Long
Dim monat8 As Long
Dim monat9 As Long
Dim monat10 As Long
Dim monat11 As Long
Dim monat12 As Long
Jahr = Sheets("Kostenkontrolle").Range("C2").Value
Set dicDat1 = CreateObject("Scripting.Dictionary")
Set dicDat2 = CreateObject("Scripting.Dictionary")
Set dicDat3 = CreateObject("Scripting.Dictionary")
Set dicDat4 = CreateObject("Scripting.Dictionary")
Set dicDat5 = CreateObject("Scripting.Dictionary")
Set dicDat6 = CreateObject("Scripting.Dictionary")
Set dicDat7 = CreateObject("Scripting.Dictionary")
Set dicDat8 = CreateObject("Scripting.Dictionary")
Set dicDat9 = CreateObject("Scripting.Dictionary")
Set dicDat10 = CreateObject("Scripting.Dictionary")
Set dicDat11 = CreateObject("Scripting.Dictionary")
Set dicDat12 = CreateObject("Scripting.Dictionary")
monat1 = Sheets("Kostenkontrolle").Range("B7").Value
monat2 = Sheets("Kostenkontrolle").Range("C7").Value
monat3 = Sheets("Kostenkontrolle").Range("D7").Value
monat4 = Sheets("Kostenkontrolle").Range("E7").Value
monat5 = Sheets("Kostenkontrolle").Range("F7").Value
monat6 = Sheets("Kostenkontrolle").Range("G7").Value
monat7 = Sheets("Kostenkontrolle").Range("H7").Value
monat8 = Sheets("Kostenkontrolle").Range("I7").Value
monat9 = Sheets("Kostenkontrolle").Range("J7").Value
monat10 = Sheets("Kostenkontrolle").Range("K7").Value
monat11 = Sheets("Kostenkontrolle").Range("L7").Value
monat12 = Sheets("Kostenkontrolle").Range("M7").Value
For Each c In Sheets("Abonnemente").Range("C16:M500").Cells
If c.Interior.Color = Sheets("Abonnemente").Range("I3").Interior.Color Then
If IsDate(c.Value) Then
If Year(c.Value) = Jahr Then
If Month(c.Value) = monat1 Then
dicDat1(c.Value) = 1
End If
End If
End If
End If
If c.Interior.Color = Sheets("Abonnemente").Range("I3").Interior.Color Then
If IsDate(c.Value) Then
If Year(c.Value) = Jahr Then
If Month(c.Value) = monat2 Then
dicDat2(c.Value) = 1
End If
End If
End If
End If
If c.Interior.Color = Sheets("Abonnemente").Range("I3").Interior.Color Then
If IsDate(c.Value) Then
If Year(c.Value) = Jahr Then
If Month(c.Value) = monat3 Then
dicDat3(c.Value) = 1
End If
End If
End If
End If
If c.Interior.Color = Sheets("Abonnemente").Range("I3").Interior.Color Then
If IsDate(c.Value) Then
If Year(c.Value) = Jahr Then
If Month(c.Value) = monat4 Then
dicDat4(c.Value) = 1
End If
End If
End If
End If
If c.Interior.Color = Sheets("Abonnemente").Range("I3").Interior.Color Then
If IsDate(c.Value) Then
If Year(c.Value) = Jahr Then
If Month(c.Value) = monat5 Then
dicDat5(c.Value) = 1
End If
End If
End If
End If
If c.Interior.Color = Sheets("Abonnemente").Range("I3").Interior.Color Then
If IsDate(c.Value) Then
If Year(c.Value) = Jahr Then
If Month(c.Value) = monat6 Then
dicDat6(c.Value) = 1
End If
End If
End If
End If
If c.Interior.Color = Sheets("Abonnemente").Range("I3").Interior.Color Then
If IsDate(c.Value) Then
If Year(c.Value) = Jahr Then
If Month(c.Value) = monat7 Then
dicDat7(c.Value) = 1
End If
End If
End If
End If
If c.Interior.Color = Sheets("Abonnemente").Range("I3").Interior.Color Then
If IsDate(c.Value) Then
If Year(c.Value) = Jahr Then
If Month(c.Value) = monat8 Then
dicDat8(c.Value) = 1
End If
End If
End If
End If
If c.Interior.Color = Sheets("Abonnemente").Range("I3").Interior.Color Then
If IsDate(c.Value) Then
If Year(c.Value) = Jahr Then
If Month(c.Value) = monat9 Then
dicDat9(c.Value) = 1
End If
End If
End If
End If
If c.Interior.Color = Sheets("Abonnemente").Range("I3").Interior.Color Then
If IsDate(c.Value) Then
If Year(c.Value) = Jahr Then
If Month(c.Value) = monat10 Then
dicDat10(c.Value) = 1
End If
End If
End If
End If
If c.Interior.Color = Sheets("Abonnemente").Range("I3").Interior.Color Then
If IsDate(c.Value) Then
If Year(c.Value) = Jahr Then
If Month(c.Value) = monat11 Then
dicDat11(c.Value) = 1
End If
End If
End If
End If
If c.Interior.Color = Sheets("Abonnemente").Range("I3").Interior.Color Then
If IsDate(c.Value) Then
If Year(c.Value) = Jahr Then
If Month(c.Value) = monat12 Then
dicDat12(c.Value) = 1
End If
End If
End If
End If
Next
Sheets("Kostenkontrolle").Range("B9") = dicDat1.Count
Sheets("Kostenkontrolle").Range("C9") = dicDat2.Count
Sheets("Kostenkontrolle").Range("D9") = dicDat3.Count
Sheets("Kostenkontrolle").Range("E9") = dicDat4.Count
Sheets("Kostenkontrolle").Range("F9") = dicDat5.Count
Sheets("Kostenkontrolle").Range("G9") = dicDat6.Count
Sheets("Kostenkontrolle").Range("H9") = dicDat7.Count
Sheets("Kostenkontrolle").Range("I9") = dicDat8.Count
Sheets("Kostenkontrolle").Range("J9") = dicDat9.Count
Sheets("Kostenkontrolle").Range("K9") = dicDat10.Count
Sheets("Kostenkontrolle").Range("L9") = dicDat11.Count
Sheets("Kostenkontrolle").Range("M9") = dicDat12.Count
End Sub
Gruss Sascha
Sub probelektionen_Mirjam() 'Probelektionen Mirjam pro Monat und Jahr
Dim c As Range
Dim Jahr As Long
Dim dicDat1 As Object
Dim monat1 As Long
Jahr = Sheets("Kostenkontrolle").Range("C2").Value
monat1 = Sheets("Kostenkontrolle").Range("B7").Value
Set dicDat1 = CreateObject("Scripting.Dictionary")
For Each c In Sheets("Abonnemente").Range("Q16:R500").Cells
If c.Text = "Probelektion" Then
If c.Interior.Color = Sheets("Abonnemente").Range("I3").Interior.Color Then
If IsDate(c.Value) Then
If Year(c.Value) = Jahr Then
If Month(c.Value) = monat1 Then
dicDat1(c) = 1
End If
End If
End If
End If
End If
Next
Sheets("Kostenkontrolle").Range("B12") = dicDat1.Count
End Sub
Ah... die Zellen in der Spalte "R" sind NICHT eingefärbt