Zählen Häufigkeit/Text - Jahr & Quartalsweise

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

HI
das geht prinzipell ohne Makro.
wenn die Lieferantenliste auf Tabelle1 fix ist, dann füge folgende Formel in C4-C13 ein:

=ZÄHLENWENNS(Tabelle3!A:A;B4;Tabelle3!B:B;">="&WERT($O$12);Tabelle3!B:B;"

bei einer Änderung in den Comboboxen Jahr bzw Quartal wird dann automatisch neu berechnet, ohne dass die Formel neu erstellt werden muss.
für eine Gesamtauswertung würde ich die Tabelle 3 um eine Hilfsspalte erweitern, in welcher du das Quartal bestimmst mit dieser Formel: =JAHR(B2)&"-"&AUFRUNDEN(MONAT(B2)/4;0)
und dann die Tabelle 3 mit Hilfe der Pivot-Tabelle nach Namen (Zeilen) und Quartal (Spalten) mit "Anzahl" auswerten, dann bekommst du eine vollständige Übersicht.
Gruß Daniel

Mahlzeit,
also ich habe Tabelle 3 nun mit einer Hilfsspalte versehen in welcher Dank der Formel das Jahr und Quartal steht.
Die Lieferantenliste auf Tabelle 1 ist nicht fix, sondern wird mit einem Makro erstellt.
Entweder: Nun müsste bei diesem Makro die Jahr- und Quartalwahl mit berücksichtigt werden, sodass nur gezählt wird, wenn entsprechend der Auswahl.

Oder: Durch Auswählen des Jahres und des Quartals die Liste auf Seite 3 entsprechend nach Jahr und Quartal filtern.
Hier das aktuelle Makro:
Dim WkSh_Q As Worksheet ' das Quell-Tabellenblatt - die Herkunft der Daten
Dim WkSh_Z As Worksheet ' das Ziel-Tabellenblatt - die Ausgabe / das Ergebnis
Dim lLetzte As Long ' die letzte belegte Zeile im Quell-Tabellenblatt
Dim aTemp As Variant ' der temporäre Array zur Aufnahme der Eingabe-Daten
Dim lZeile As Long ' der For/Next Schleifen-Index - hier die Zeile im Array
Dim rZelle As Range ' die Ausgabe-Zelle für das Zwischen-Ergebnis
Dim MyDict As Variant ' das Dictionary
' das Quell- und das Ziel-Tabellenblatt festlegen
Set WkSh_Q = ThisWorkbook.Worksheets("Tabelle3") ' den Tabellenblattnamen ggf. anpassen!
Set WkSh_Z = ThisWorkbook.Worksheets("Auswertung") ' den Tabellenblattnamen ggf. anpassen!
Application.ScreenUpdating = False ' kein Bildschirm-Update während des Makros zulassen
' die letzte belegte Zeile ermitteln
lLetzte = WkSh_Q.Cells(WkSh_Q.Rows.Count, 1).End(xlUp).Row
' die Quell-Daten zur schnelleren Bearbeitung in ein Array kopieren
aTemp = WkSh_Q.Range("A2:A" & lLetzte)
' den Ausgabe-Bereich in Tabelle3 leeren/löschen
WkSh_Q.Range("D2:E" & lLetzte).ClearContents
' das Object Scripting_Dictionary festlegen
Set MyDict = CreateObject("Scripting.Dictionary")
On Error Resume Next
' die Daten an das Dictionary übergeben und deren Vorkommen/Häufigkeit zählen
' mit Trim$ führende und/oder nachfolgende Leerstellen in den Namen entfernen
' wegen unterschiedlicher Schreibweisen alles in Kleinbuchstaben umwandeln
For lZeile = 1 To UBound(aTemp)
aTemp(lZeile, 1) = LCase(Trim$(aTemp(lZeile, 1)))
MyDict(aTemp(lZeile, 1)) = MyDict(aTemp(lZeile, 1)) + 1
Next lZeile
'
' ausgeben
'
Set rZelle = WkSh_Q.Cells(2, 4) ' die erste Ausgabe-Zelle in Tabelle3 festlegen
'
'Application.EnableEvents = False ' hier nicht erforderlich
rZelle.Resize(MyDict.Count) = WorksheetFunction.Transpose(MyDict.Keys)
rZelle.Offset(0, 1).Resize(MyDict.Count) = WorksheetFunction.Transpose(MyDict.Items)
'Application.EnableEvents = True ' hier nicht erforderlich
'
' sortieren - vorher erneut die jetzt verbliebene letzte belegte Zeile ermitteln
'
lLetzte = WkSh_Q.Cells(WkSh_Q.Rows.Count, 4).End(xlUp).Row
WkSh_Q.Range("D2:E" & lLetzte).Sort _
Key1:=WkSh_Q.Range("E2"), Order1:=xlDescending, _
Key2:=WkSh_Q.Range("D2"), Order2:=xlAscending, _
Header:=xlNo, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
'
' die 10 ersten (höchsten) Vorkommen in's Ziel-Tabellenblatt kopieren
'
WkSh_Q.Range("D2:E11").Copy Destination:=WkSh_Z.Range("B4:C13")
' den ersten Buchstaben im Wort wieder groß schreiben
For Each rZelle In WkSh_Z.Range("B4:B13")
rZelle.Value = Application.Proper(rZelle.Value)
Next rZelle
' optimale Spalten-Breite herstellen
With WkSh_Z
.Columns("B:B").Columns.AutoFit
.Columns("C:C").Columns.AutoFit
End With
'
' die Ergebnisse einrahmen
'
For Each rZelle In WkSh_Z.Range("B4:C13")
rZelle.Borders.LineStyle = xlContinuous
Next rZelle
'
' die Spalte E zentrieren
'
With WkSh_Z.Range("C4:C13")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Application.ScreenUpdating = True ' den Bildschirm-Update wieder zulassen
Sheets("Auswertung").Select

dim obereGrenze as Date dim untereGrenze as Date obereGrenze = Sheets("Tabelle1").Range("P12").Value untereGrenze = Sheets("Tabelle1").Range("O12").Value For lZeile = 1 To UBound(aTemp) if aTemp(lZeile, 2) >= untereGrenze Then if aTemp(lZeile, 2)

Beliebteste Forumthreads (12 Monate)

Zählen Häufigkeit/Text - Jahr & Quartalsweise

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zählen Häufigkeit/Text - Jahr & Quartalsweise

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread