VBA-Programmierung in Microsoft Excel

Tutorial: Excel-Beispiele

Werte nach zwei Kriterien auswählen

Gruppe

Matrix

Bereich

Matrixfunktion

Thema

Werte nach zwei Kriterien auswählen

Problem

Wie kann ich Werte nach zwei Kriterien summieren? Sowohl die Funktion ZÄHLENWENN als auch SUMMEWENN akzeptieren nur ein Kriterium.

Lösung

Die Matrixformel: {=SUMME((date=E2)*(Account=F2)*Amount)}




StandardModule: basMain

Sub NachWertKopieren()
   Dim wksSource As Worksheet, wksTarget As Worksheet
   Dim rng As Range
   Dim arr(1 To 4) As Double
   Dim iCounter As Integer, iRow As Integer, iCount As Integer
   Application.ScreenUpdating = False
   Set wksSource = ActiveSheet
   arr(1) = 100
   arr(2) = 1000
   arr(3) = 10000
   arr(4) = 100000
   For iCounter = 1 To 5
      If iCounter = 1 Then
         wksSource.Range("A1").AutoFilter Field:=2, _
            Criteria1:="<=" & CStr(arr(iCounter))
      ElseIf iCounter < 5 Then
         wksSource.Range("A1").AutoFilter Field:=2, _
            Criteria1:=">" & CStr(arr(iCounter - 1)), _
            Operator:=xlAnd, Criteria2:="<=" & _
            CStr(arr(iCounter))
      Else
         wksSource.Range("A1").AutoFilter Field:=2, _
            Criteria1:=">" & CStr(arr(iCounter - 1))
      End If
      iCount = WorksheetFunction.Subtotal(2, _
         wksSource.Range("A1").CurrentRegion)
      If iCount > 0 Then
         Set rng = wksSource.Range("A1").CurrentRegion _
            .SpecialCells(xlCellTypeVisible)
         On Error Resume Next
         Set wksTarget = Worksheets(wksSource _
            .AutoFilter.Filters(2).Criteria1)
         If Err > 0 Or wksTarget Is Nothing Then
            Err.Clear
            Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
            ActiveSheet.Name = _
               wksSource.AutoFilter.Filters(2).Criteria1
            rng.Copy Range("A3")
            Rows(3).Delete
         Else
            iRow = wksTarget.Cells(Rows.Count, 1).End(xlUp).Row + 1
            rng.Copy wksTarget.Cells(iRow, 1)
            wksTarget.Rows(iRow).Delete
         End If
         On Error GoTo 0
      End If
   Next iCounter
   wksSource.Select
   ActiveSheet.AutoFilterMode = False
   Application.ScreenUpdating = True
End Sub

    


Beiträge aus dem Excel-Forum zu den Themen Matrix und Matrixfunktion