Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1640to1644
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

VBA - Anzahl von Monatseinträgen eines Jahres

VBA - Anzahl von Monatseinträgen eines Jahres
28.08.2018 15:41:16
Monatseinträgen
Aloha Community.
Ich habe in den Zellen A1-A200 einer Datei A Daten untereinander stehen. Der Zellbereich ist als Datum formatiert.
Ziel ist es in die Zellen B1-B12 einer Datei B die Anzahl aller Einträge zu schreiben, die für die Monate Januar bis Dezember des Jahres 2017 in Datei A enthalten sind.
Im weiten Netz stoße ich leider immer wieder auf =ZÄHLENWENN.
Ich benötige jedoch eine VBA-Lösung und bitte um Hilfe.

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
In VBA heißt das "COUNTIF" ... owT
28.08.2018 15:48:13
Matthias
AW: VBA - Anzahl von Monatseinträgen eines Jahres
28.08.2018 15:48:26
Monatseinträgen
Hi
z.B.
Sub t()
MsgBox Evaluate("SUMPRODUCT(N(YEAR([Mappe1.xlsx]Tabelle1!A1:A200)=2017))")
End Sub

cu
Chris
AW: VBA - Anzahl von Monatseinträgen eines Jahres
28.08.2018 15:52:06
Monatseinträgen
Hallo,
Warum um Himmelswillen eine VBA Lösung?
Das ist ein klassisches Problem für eine Pivottabelle!
Gruess Hansueli
AW: VBA - Anzahl von Monatseinträgen eines Jahres
28.08.2018 19:33:34
Monatseinträgen
@EtoPHG
Für dieses Beispiel hast du Recht. Aus Gründen der Übersicht habe ich die Problematik stark reduziert. Damit ich es umfangreicher umsetzen kann brauche bei kleinen Stolpersteinen Hilfe.
@ChrisL
Ich habe es umgesetzt. Allerdings führt dies nicht zum Erfolg.
Wo gebe ich den benötigten Monat ein?
Sub Import()
Dim QD, QP As String      'Quelldatei, Quellpfad
QP = "C:\..."
QD = Dir(QP & "\*." & "xlsx")
MsgBox Evaluate("SUMPRODUCT(N(YEAR([QD]Tabelle1!A1:A200)=2017))")
End Sub
Als Beispiel die zwei aufbereiteten Dateien.
https://www.herber.de/bbs/user/123623.zip
Anzeige
AW: VBA - Anzahl von Monatseinträgen eines Jahres
28.08.2018 19:38:22
Monatseinträgen
Hi
Die Dateien habe ich nicht geöffnet, vielleicht hilft schon
"SUMPRODUCT(N(YEAR([" & QD & "]Tabelle1!A1:A200)=2017))"
cu
Chris
AW: VBA - Anzahl von Monatseinträgen eines Jahres
28.08.2018 20:06:41
Monatseinträgen
Leider nein. Laufzeitfehler 13: Typen unverträglich.
Ich müsste irgendwo den Monat eingeben können, den ich ausgewertet haben möchte.
Mich interessieren nicht die Einträge des Jahres 2017, sondern der einzelnen Monate von 2017.
AW: VBA - Anzahl von Monatseinträgen eines Jahres
29.08.2018 08:38:58
Monatseinträgen
Habe eine Lösung gefunden. Ob es kompakter und eleganter geht, weiß ich aktuell noch nicht.
Zum Nachvollziehen siehe Anhang.
https://www.herber.de/bbs/user/123629.zip
Sub Import()
Dim QD, QP As String      'Quelldatei, Quellpfad
Dim QAM As Workbook
Set ZRB = ThisWorkbook.Sheets(1)
QP = "C:\..."
QD = Dir(QP & "\*." & "xlsx")
Set QAM = Workbooks.Open(QP & "\" & QD)
Set QRB = QAM.Sheets(1)
Set R = Range(QRB.Cells(1, 1), QRB.Cells(10000, 1))
l = Application.WorksheetFunction.CountA(R)
For i = 0 To l
Datum = QRB.Cells(1 + i, 1)
M = Month(Datum)
Y = Year(Datum)
If M = 1 And Y = 2015 Then Jan = Jan + 1
If M = 2 Then Feb = Feb + 1
If M = 3 Then Mar = Mar + 1
If M = 4 Then Apr = Apr + 1
If M = 5 Then May = May + 1
If M = 6 Then Jun = Jun + 1
If M = 7 Then Jul = Jul + 1
If M = 8 Then Aug = Aug + 1
If M = 9 Then Sep = Sep + 1
If M = 10 Then Octo = Octo + 1
If M = 11 Then Nov = Nov + 1
If M = 12 Then Dec = Dec + 1
Next
ZRB.Range("B1") = Jan
ZRB.Range("B2") = Feb
ZRB.Range("B3") = Mar
ZRB.Range("B4") = Apr
ZRB.Range("B5") = May
ZRB.Range("B6") = Jun
ZRB.Range("B7") = Jul
ZRB.Range("B8") = Aug
ZRB.Range("B9") = Sep
ZRB.Range("B10") = Octo
ZRB.Range("B11") = Nov
ZRB.Range("B12") = Dec
QAM.Close False
End Sub

Anzeige
AW: VBA - Anzahl von Monatseinträgen eines Jahres
29.08.2018 10:02:30
Monatseinträgen
sauberer:
Sub Import()
Dim QD, QP As String      'Quelldatei, Quellpfad
Dim R As Range
Dim QAM As Workbook
Set ZRB = ThisWorkbook.Sheets(1)
QP = "C:\..."
QD = Dir(QP & "\*." & "xlsx")
Set QAM = Workbooks.Open(QP & "\" & QD)
Set QRB = QAM.Sheets(1)
Set R = Range(QRB.Cells(1, 1), QRB.Cells(10000, 1))
l = Application.WorksheetFunction.CountA(R)
For j = 0 To 11
Mi = 0
For i = 0 To l
Datum = QRB.Cells(1 + i, 1)
M = Month(Datum)
Y = Year(Datum)
If M = 1 + j Then Mi = Mi + 1
If Mi = 0 Then GoTo 1
ZRB.Cells(1 + j, 2) = Mi
1
Next
Next
QAM.Close False
End Sub

Anzeige

311 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige