Thema Datum  Von Nutzer Rating
Antwort
25.02.2021 19:29:27 Moritz
NotSolved
25.02.2021 20:30:45 Gast5114
NotSolved
25.02.2021 20:46:35 Gast65691
NotSolved
25.02.2021 21:11:53 Moritz
NotSolved
Rot Zählenwenns mit 3 Bedingungen auf mehreren Tabellenblättern
 25.02.2021 23:59:57 Gast15205
****
NotSolved
26.02.2021 00:06:49 Gast15205
NotSolved
26.02.2021 00:15:36 Gast15205
NotSolved
26.02.2021 00:18:32 Gast25200
NotSolved
26.02.2021 00:21:33 Gast15205
NotSolved
26.02.2021 00:27:42 Gast15205
****
NotSolved
25.02.2021 21:51:00 xlKing
****
NotSolved
25.02.2021 22:18:45 Gast32374
NotSolved
25.02.2021 22:35:47 xlKing
NotSolved

Ansicht des Beitrags:
Von:
Gast15205		 Datum:
25.02.2021 23:59:57		 Views:
373		 Rating:
     
Antwort:
  Ja
Thema:
Zählenwenns mit 3 Bedingungen auf mehreren Tabellenblättern

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:

?
1
2
3
4
5
6
7
8
9
10
11
'
' 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:

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
'
' 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

 

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:
WYSIWYG-Editor, ctl00_Content_editor1



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
25.02.2021 19:29:27 Moritz
NotSolved
25.02.2021 20:30:45 Gast5114
NotSolved
25.02.2021 20:46:35 Gast65691
NotSolved
25.02.2021 21:11:53 Moritz
NotSolved
Rot Zählenwenns mit 3 Bedingungen auf mehreren Tabellenblättern
 25.02.2021 23:59:57 Gast15205
****
NotSolved
26.02.2021 00:06:49 Gast15205
NotSolved
26.02.2021 00:15:36 Gast15205
NotSolved
26.02.2021 00:18:32 Gast25200
NotSolved
26.02.2021 00:21:33 Gast15205
NotSolved
26.02.2021 00:27:42 Gast15205
****
NotSolved
25.02.2021 21:51:00 xlKing
****
NotSolved
25.02.2021 22:18:45 Gast32374
NotSolved
25.02.2021 22:35:47 xlKing
NotSolved