für Profis: Erweiterung?
27.07.2006 14:16:39
Moritz
Ich möchte gerne den unten stehenden Code erweitern.
Ich möchte statt nur in der Spalte "Katze", in ALLEN Spalten die mit "Katze..." beginnen die Zahlen addieren, welche in der gleichen Zeile wie "rot" in Spalte "Maus" stehen... (siehe Code...)
Ich hoffe mir kann jemand weiterhelfen..
Danke, Gruß Max
Sub Sondersumme()
Sheets("Tabelle1").Select
Dim dblSumme As Double, strBegriffSumme As String, strBegriffKriterium, strKriterium As String
Dim rngBegriffSumme As Range, rngBegriffKriterium As Range
Dim wks As Worksheet, rngBegriff As Range, lngZeile As Long
Set wks = ActiveSheet
Set rngBegriff = wks.Range("A3:Z3") ' Bereich in dem Begriffe gesucht werden sollen
'Eingabe der Begriffe und des Kriteriums
strBegriffSumme = "Katze"
strBegriffKriterium = "Maus"
strKriterium = "rot"
'Suchen der Zellen mit den Begriffen
Set rngBegriffSumme = rngBegriff.Find(What:=strBegriffSumme, LookIn:=xlValues, Lookat:=xlWhole)
Set rngBegriffKriterium = rngBegriff.Find(What:=strBegriffKriterium, LookIn:=xlValues, Lookat:=xlWhole)
If (rngBegriffSumme Is Nothing) Or (rngBegriffKriterium Is Nothing) Then
MsgBox "Begriff '" & strBegriffSumme & "' oder '" & strBegriffKriterium & "' wurde nicht gefunden"
Exit Sub
End If
'Summenermittlung
With wks
'Letzte Zeile mit Daten in Spalte mit Begriff1 (strBegriffSumme)
lngZeile = wks.Cells(wks.Rows.Count, rngBegriffSumme.Column).End(xlUp).Row
'Zellinhalte unterhalb Begriff 1 summieren, wenn Kriterium unter Begriff 2 erfüllt ist
dblSumme = Application.WorksheetFunction.SumIf(.Range(.Cells(rngBegriffSumme.Row + 1, _
rngBegriffKriterium.Column), .Cells(lngZeile, rngBegriffKriterium.Column)), _
"=" & strKriterium, .Range(.Cells(rngBegriffSumme.Row + 1, rngBegriffSumme.Column), _
.Cells(lngZeile, rngBegriffSumme.Column)))
End With
Tabelle2.Range("B4").Value = dblSumme
End Sub