Application.WorksheetFunction.DCountA
11.05.2016 18:59:37
BlueBull
über den folgenden Code möchte ich alle werte (Texte) die aus einer Gruppe kommen addieren. Der Code funktioniert auch, allerdings verstehe ich nicht warum ich bei dem 2ten Case Genehmigt Sum_Antraege abziehen muss um den korrekten Wert zu erhalten. Seh ich den Wald vor lauter Bäume nicht?
Über Anregungen wurde ich mich freuen...
Gruß
Sub Rechne()
Dim DBAnzVar As Range
Dim DB As Range
Dim i As Variant
Dim Antraege As Range
Dim DB_Antraege As Range
Dim Sum_Antraege As Range
Dim Genehmigt As Range
Dim DB_Genehmigt As Range
Dim Sum_Genehmigt As Range
' Fixe Werte
Set wks = Sheets("Tabelle1")
' Variablen für Suchkriterium
Set Antraege = wks.Range("B19")
Set Genehmigt = wks.Range("C19")
Set DB_Antraege = wks.Range("B19:B" & wks.Cells(Rows.Count, "B").End(xlUp).Row)
Set DB_Genehmigt = wks.Range("C19:C" & wks.Cells(Rows.Count, "C").End(xlUp).Row)
Application.ScreenUpdating = False
' Berechnung Einträge
For i = ActiveCell.Column To ActiveCell.Column + Selection.Columns.Count - 1
Set DBAnzVar = wks.Cells(4, i)
Set DB = wks.Range(Cells(4, i), Cells(17, i))
Select Case DBAnzVar
Case Is = Antraege
Set Sum_Antraege = wks.Cells(1, i)
Sum_Antraege = Application.WorksheetFunction.DCountA(DB, Antraege, DB_Antraege)
Case Is = Genehmigt
Set Sum_Genehmigt = wks.Cells(2, i)
Sum_Genehmigt = Application.WorksheetFunction.DCountA(DB, Genehmigt, DB_Genehmigt) - _
Cells(1, i) ' Warum muss ich bei diesem Fall Sum_Antraege abziehen?
End Select
Next
Application.ScreenUpdating = True
End Sub