Dann hier mal eine flexible Lösung. Die Ergebnisse werden in der Übersicht automatisch aktualisiert, sobald sich auf einem der anderen Blätter etwas ändert - bei Werte werden in die Zellen D3 und D11 geschrieben (also die von dir markierten).
Beachte bitte, das der CodeName der Tabelle Übersicht in den Eigenschaften (F4 im VBA-Editor) zu "tblCustomView" geändert wurde.
Hier die zwei Makros:
'
' KlassenModul: DieseArbeitsmappe / ThisWorkbook
'
Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'Tabelleblatt mit dem Namen "Übersicht" wird ignoriert
If 0 <> StrComp(Sh.Name, tblCustomView.Name, vbTextCompare) Then
Call tblCustomView.UpdateView
End If
End Sub
und:
'
' KlassenModul: Tabelle "Übersicht" (CodeName: tblCustomView)
'
Option Explicit
Private Enum CustomResultArgsEnum
TableTopLeftCellAddr = 0
WorkerColumn = 1
WorkerValue
DateColumn
DateValue
StatusColumn
StatusValue
Status_Op
[_Min] = TableTopLeftCellAddr
[_Max] = Status_Op
[_Default] = WorkerColumn
End Enum
Private Enum CustomResultEnum
EqualVM = 1
NotEqualVM
[_Min] = EqualVM
[_Max] = NotEqualVM
[_Default] = EqualVM
End Enum
Public Sub UpdateView()
'hier werden die errechneten Werte gesammelt
Dim alngResult(CustomResultEnum.[_Min] To CustomResultEnum.[_Max]) As Long
'Argumente für die Berechnung
Dim astrArgs(CustomResultArgsEnum.[_Min] To CustomResultArgsEnum.[_Max]) As String
'für den Excel Formelausdruck zur Berechnung der Werte
Dim strFormula As String
'>>>>>>> CONFIG >>>>>>>
'obere linke Zelle der Tabelle(n) - inkl. Kopfzeile
astrArgs(CustomResultArgsEnum.TableTopLeftCellAddr) = "A1"
'Spalten-Index so wie sie im jeweiligen Blatt angezeigt werden
astrArgs(CustomResultArgsEnum.WorkerColumn) = "B"
astrArgs(CustomResultArgsEnum.DateColumn) = "K"
astrArgs(CustomResultArgsEnum.StatusColumn) = "R"
'<<<<<<< CONFIG <<<<<<<
Dim wks As Excel.Worksheet
Dim rngData As Excel.Range
Dim blnSkip As Boolean
Dim i As Long
For Each wks In ThisWorkbook.Worksheets
'Tabelleblatt mit dem Namen "Übersicht" wird übersprungen
blnSkip = StrComp(wks.Name, "Übersicht", vbTextCompare) = 0
If blnSkip = False Then
With wks.Range(astrArgs(CustomResultArgsEnum.TableTopLeftCellAddr))
Set rngData = .Worksheet.Cells(.Row, .Worksheet.Columns.Count).End(xlToLeft)
Set rngData = .Worksheet.Range(rngData, .Worksheet.Cells(.Worksheet.Rows.Count, .Column).End(xlUp))
If rngData.Row < .Row Then
'wir sind über der Kopfzeile gelandet
Call MsgBox("Keine Daten / Außerhalb der Kopfzeilen-Definition gelandet.", vbCritical)
Exit Sub
ElseIf rngData.Rows.Count = 1 Then
'keine Daten unter der Kopfzeile
blnSkip = True
Else
'setze Argumente für Excel-Formel (s. unten)
'Spalte: Bearbeiter
astrArgs(CustomResultArgsEnum.WorkerValue) = rngData.Columns(astrArgs(CustomResultArgsEnum.WorkerColumn)).Offset(0, 1 - rngData.Column).Address
'Spalte: Datum
astrArgs(CustomResultArgsEnum.DateValue) = rngData.Columns(astrArgs(CustomResultArgsEnum.DateColumn)).Offset(0, 1 - rngData.Column).Address
'Spalte: Status
astrArgs(CustomResultArgsEnum.StatusValue) = rngData.Columns(astrArgs(CustomResultArgsEnum.StatusColumn)).Offset(0, 1 - rngData.Column).Address
End If
End With
If blnSkip = False Then
For i = LBound(alngResult) To UBound(alngResult)
'Vergleichsoperator (für Spalte: Bearbeiter) setzen
Select Case i
Case CustomResultEnum.EqualVM: astrArgs(CustomResultArgsEnum.Status_Op) = "<>"
Case CustomResultEnum.NotEqualVM: astrArgs(CustomResultArgsEnum.Status_Op) = "="
Case Else: blnSkip = True
End Select
If blnSkip Then
blnSkip = False
Else
'Excel-Formel-Ausdruck mit $Platzhaltern$
strFormula = "=COUNTIFS(" & _
"$ARG.1$,""Note 3 FG""," & _
"$ARG.2$,"">=""&DATE(YEAR(TODAY()),MONTH(TODAY()),1), $ARG.2$,""<=""&DATE(YEAR(TODAY()),MONTH(TODAY())+1,0)," & _
"$ARG.3$,""$ARG.4$VM"")"
'ersetze Argument-Platzhalter in der Formel mit ihrem Wert (s. oben)
strFormula = Replace$(strFormula, "$ARG.1$", astrArgs(CustomResultArgsEnum.StatusValue), Compare:=vbTextCompare)
strFormula = Replace$(strFormula, "$ARG.2$", astrArgs(CustomResultArgsEnum.DateValue), Compare:=vbTextCompare)
strFormula = Replace$(strFormula, "$ARG.3$", astrArgs(CustomResultArgsEnum.WorkerValue), Compare:=vbTextCompare)
strFormula = Replace$(strFormula, "$ARG.4$", astrArgs(CustomResultArgsEnum.Status_Op), Compare:=vbTextCompare)
'Ergebnis(se) aufsummieren
alngResult(i) = alngResult(i) + rngData.Worksheet.Evaluate(strFormula)
End If
Next 'i
End If 'blnSkip = False
End If 'StrComp(wks.Name, ...)
Next 'wks
'Makro-Events: AUS
Application.EnableEvents = False
'Werte in Übersicht ausgeben
Range("D3").Value = alngResult(CustomResultEnum.EqualVM)
Range("D11").Value = alngResult(CustomResultEnum.NotEqualVM)
'Makro-Events: AN
Application.EnableEvents = True
End Sub
|