Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1412to1416
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
Inhaltsverzeichnis

Zählenwenn ohne doppelte als vba

Zählenwenn ohne doppelte als vba
01.03.2015 19:16:40
Sascha
Hallo Experten,
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

18
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zählenwenn ohne doppelte als vba
01.03.2015 20:18:53
Daniel
Hi
per VBA würde man hier ein DictionaryObjekt erstellen:
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.
Hier erstellt man ein solches Dictionary und macht für jeden Tag einen Eintrag (wenn das Jahr stimmt).
Wiederholte Einträge für das selbe Datum bewirken nichts, sie werden einfach überschrieben.
Einträge für noch nicht vorhandene Datumswerte werden hinzugefügt.
Am schluss zählt man dann die Anzahl der gemachten Einträge.
am Anfang liest man alle Werte in ein Array ein, weil Excel mit schleifen über solche Wertarrays deutlich schneller ist als mit Schleifen über Excelzellen.
Gruß Daniel

Anzeige
AW: Zählenwenn ohne doppelte als vba
01.03.2015 20:34:19
Sascha
Hallo Daniel,
Super, so funktioniert es Prima.
Noch eine Frage:
Nun möchte ich noch dass es nur die Zellen auf doppelte überprüft in denen die Zellen die richtige Farbe haben...
Habs versucht mit:
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

Anzeige
AW: Zählenwenn ohne doppelte als vba
01.03.2015 20:49:44
Daniel
HI
1. ins Array werden nur die Zellwerte übernommen.
wenn du die Farben mit prüfen willst, muss die Schleife über die Zellen laufen, sonst kannst du die Farbwerte nicht ermitteln.
2. wenn du deine eigenen Prüfungen mit hinein nimmst, dann solltest du meine Prüfungen entfernen, wenn diese nicht mehr relevant sind.
3. die Prüfung "If IsDate(...)" soll Fehlerabbrüche vermeiden wenn in den Zellen Text steht und deswegen die Funktion YEAR einen Fehlerabbruch erzeugen würde.
Diese Prüfung muss natürlich vor der Verwendung von YEAR erfolgend und darf nicht in derselben IF-Bedingung stehen.
4. wenn möglich, sollen man mehrere Bedingungen für einen IF-Block nicht mit AND verknüpfen, sonden für jede Bedingung einen neuen IF-Block mit Prüfung erstellen und diese ineinander schachteln.
bei einem IF-Block, der jede Bediungung mit AND verknüpft enthält, wird auch jede Bedingung berechnet.
Das ist erhöhter Rechenaufwand, weil jede Bedinung immer geprüft wird, bei geschachtelten IF-Blöcken wird nur die erste Bediungung immer geprüft, die weiteren nur, wenn die davorliegende erfüllt ist.
So eine geschachteltere Prüfung ist dann auch für die Vermeidung von Fehlerabbrüchen geeignet.
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

Gruß Daniel

Anzeige
AW: Zählenwenn ohne doppelte als vba
01.03.2015 21:05:35
Sascha
Hallo Daniel,
Sorry, nun steh ich ganz aufm Schlauch. Bin glaube schon zu lange im VBA für heute...
Habs versucht mit:
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
Gruss Sascha

Anzeige
AW: Zählenwenn ohne doppelte als vba
01.03.2015 21:13:00
Daniel
Hi
mir fällt es jetzt schwer dazu was zu sagen, weil ich deine Datei nicht kenne und deine angaben wiederspüchlich sind
erst wird in C15:M500 gezählt, dann in A1:A500 zum Schluss dann in A1:A10
das Jahr für die Auswertung steht mal im aktuellen Blatt in D2, dann wieder im Blatt "Kostenkontrolle" in der Zelle C2.
Da musst du erstmal klarheit reinbringen, bevor ich deine weiteren Codeversuche beurteilen kann.
Lade mald deine Datei hoch, damit man auch die Umfeldparameter sehen kann.
gruß Daniel

AW: Zählenwenn ohne doppelte als vba
01.03.2015 21:53:15
Sascha
Hi Daniel,
Vielen Dank für Deine Geduld.
Ich habe halt zu Testzwecken ein neues Arbeitsblatt erstellt mit weniger Daten.
Ok. nun nochmals zur Lage.
Ich habe eine Mappe mit mehreren auch doppelten Daten, diese jeweils nach Farbe. Blatt1,(C16:M500)
Ich möchte dass es mir die Anzahl Daten nach Jahr Blatt1, (D2) und schlussendlich noch nach Monat und nach Farbe anzeigt, dies aber ohne die doppelten Daten. Auf dem 2. Tabellenblatt in B9:M9 und N9:Y9 muss ich eruiren können wieviele Lektionen(Daten) es waren, für jeden Monat und nach Jahr und nach Farbe (für beide Leiterinnen) (D2) auf Blatt 1.
Im Modul1 sind die beiden Codes (ZählenDatumfürJahr und ZählenDatumfürJahr1).
Der Code ZählenDatumfürJahr bringt mir das richtige Ergebnis, Der Code ZählenDatumfürJahr1 leider nicht. der zählt nur die Anzahl Daten mit der jeweiligen Farbe aber inkl. doppelte.
Hier die Mappe:
https://www.herber.de/bbs/user/96096.xlsm
Vielen lieben Dank für Deine Mühe
Sascha

Anzeige
AW: Zählenwenn ohne doppelte als vba
01.03.2015 22:12:44
Daniel
hi
dein Code ZählenDatumfürJahr1 bringt das Ergebnis 0, was in erster linie daran liegt, das die Hintergrundfarbe der Bedingung ZählenDatumfürJahr1 ( RGB(194, 214, 154)) in den Zellen nicht vorkommt.
geprüfte Farbe RGB(194, 214, 154) = 10147522
farbe in den Zellen: 10213316 und 14470546
Gruß Daniel

AW: Zählenwenn ohne doppelte als vba
01.03.2015 22:19:53
Sascha
Hallo Daniel
Kann das an den Excel Versionen liegen?
Bei mir stimmen die Farben
Gruss Sascha

AW: Zählenwenn ohne doppelte als vba
01.03.2015 22:42:53
Daniel
durchaus möglich
ich hab Excel 2010
du kannst die Funktion ja dahingehen abändern, dass du den Farbwert aus einer Beispielzelle ausliest, dann ist es Versionsunabhängig.
Gruß Daniel

Anzeige
AW: Zählenwenn ohne doppelte als vba
02.03.2015 04:22:26
Sascha
Hallo Daniel,
Hab ich gemacht. dasselbe Ergebnis. Es zählt einfach alle mit dieser Farbe ohne die doppelten abzuziehen...
Hast Du eine Idee woran es liegen könnte?
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

Gruss Sascha

Anzeige
AW: Zählenwenn ohne doppelte als vba
02.03.2015 06:30:55
daniel
Hi
Probier mal
dicDat(c.value) = 1
Gruß Daniel

AW: Zählenwenn ohne doppelte als vba
03.03.2015 07:33:37
Sascha
Guten Morgen Daniel,
Sorry dass ich mich gestern nicht gemeldet habe, Hatte den ganzen Tag Sitzung.
Ja, das wars... Super.
Nun kann ich mit dicDat(c.value) = 1 die Anzahl ohne doppelte zählen, und mit dicDat(c) = 1
die gesamte Anzahl...
Das ist Perfekt.
Vielen Dank.
Darf ich Dich hier auch nach etwas anderem (langer Code kürzen) fragen, oder soll ich einen neuen Beitrag verfassen?
Liebe Grüsse
Sascha

AW: Zählenwenn ohne doppelte als vba
03.03.2015 07:44:03
daniel
Hi
Wenn neues Thema, dann neuer Beitrag.
Dann können auch andere helfen. Vielleicht hab ich ja keine Lust, Zeit oder zu wenig Wissen für das Problem.
Gruß Daniel

Anzeige
AW: Zählenwenn ohne doppelte als vba
03.03.2015 07:48:25
Sascha
OK
Vielen Dank Daniel
Unglaublich wie schnell Du reagierst :-)
Liebe Grüsse
Sascha

AW: Zählenwenn ohne doppelte als vba
03.03.2015 08:05:56
Sascha
Ähmmm Daniel,
Sorry...
Ich habe nun Deinen Code angepasst und zwar für 12 Monate. Ist extrem lang geworden. Und braucht dementsprechend eine gewisse Zeit um diesen zu errechnen.
Deshalb die Frage ob es Möglich ist, den Code auf ein Minimum zu beschränken. Ich weis leider nicht wie ich zum Beispiel eine Schlaufe machen kann mit diesem Code.
Hier der Original Code für 1 Monat:
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:
Option Explicit
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

Anzeige
AW: Zählenwenn ohne doppelte als vba
03.03.2015 09:05:10
daniel
Hi
Das Problem ist, dass ich diese Auswertung nicht über ein Dictionary lösen würde, sondern über ein normales Array.
Jedes Datum entspricht einer Ganzzahl.
Dh du kannst ein Array über den Datumsbereich bilden und auf den entsprechenden Indexplatz eine 1 setzen, wenn die Zelle mir dem Datum gefärbt ist.
Wenn du jetzt für einen bestimmten Monat die Anzahl der Tage wissen willst,geghst du das Array per Schleife vom Index Monatsanfang bis -ende durch und summierst die Werte.
Gruß Daniel

AW: Zählenwenn ohne doppelte als vba
03.03.2015 10:13:15
Sascha
Hallo Daniel,
Vielen Dank für Deine schnelle Antwort.
Ich lass es mal so bleiben. Das mit den Arrays klingt sehr kompliziert.
Es funktioniert ja. Nach ca. 8 sek habe ich das Ergebnis.
Aber vielen lieben Dank für Deine Hilfe.
Ich habe richtig Freude dass es klappt :-))
*Daumenhoch*
Liebe Grüsse
Sascha

AW: Zählenwenn ohne doppelte als vba
03.03.2015 15:18:22
Sascha
Hallo Daniel,
ich brauche nochmals eine Hilfe zu Deinem Code.
Ich möchte ein weiteres Kriterium setzen.
Es soll mir alle Einträge die mit der Farbe und dem Datum und dem Monat (wie bis jetzt) vorhanden sind, aber nur die, welche in der dazugehörigen rechten Spalte "Problektion" drin stehen haben.
habs so probiert, jedoch ohne Erfolg:
Option Explicit
Option Private Module
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
Magst Du mir nochmals helfen?
Gruss Sascha

323 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige