Code-Optimierung
Lena
ich brauche wieder mal eure Hilfe.
Ich habe eine Excel-Anwendung zur Anzeige der Daten eines Kunden / einer Branche / einer Abteilung. Welche Daten angezeigt werden sollen, bestimmt der Benutzer anhand mehrerer Auswahllisten. Die Auswahlkriterien können auch kombiniert werden, bspw. Zeige die Summe der Umsätze, welche die Abteilung X mit der Branche Y gemacht hat.
Die Rohdaten liegen in tabellarischer Form vor:
Kunde | Branche | Abteilung | Umsatz |
Die Berechnung geschieht mit der Funktion mySummewenn (Code s.u., bspw.
=mysummewenn(Umsatz; A1:D1000;Kunde;(Alle);Branche;Branche Y;Abteilung X)
Da die Rohdaten aber in letzter Zeit stark angewachsen sind und die Anzahl von Auswahlkriterien von 3 auf 6 erhöht wurde, liegen die Antwortzeiten mittlerweile bei über 1 Minute, was kaum noch akzeptabel ist.
Hat jemand eine Idee, wie man den Code optimieren kann?
Viele Grüße
--------
'Summewenn mit mehreren Kriterien.
'
' - Bereich: Rohdaten, in welchen gesucht werden soll. Die erste Zeile enthält die Spaltenüberschriften,
' die in der Funktion vewendet werden.
' - Summespalte: Die Überschrift der Spalte, die summiert werden soll
' - Parametername: die Überschrift der Spalte, über die eingeschränkt werden soll
' - Parameterwert: Einschränkungskriterium
Const alle As String = "(Alle)"
Public Function mySummewenn(ByVal SummeSpalte As String, Bereich As Range, _
Optional ParameterName_1 As String, Optional ParameterWert_1 As String, _
Optional ParameterName_2 As String, Optional ParameterWert_2 As String, _
Optional ParameterName_3 As String, Optional ParameterWert_3 As String, _
Optional ParameterName_4 As String, Optional ParameterWert_4 As String, _
Optional ParameterName_5 As String, Optional ParameterWert_5 As String, _
Optional ParameterName_6 As String, Optional ParameterWert_6 As String, _
Optional ParameterName_7 As String, Optional ParameterWert_7 As String)
Dim anzahlSpalten As Byte
Dim anzahlZeilen As Integer
Dim intHelp As Integer
Dim parameterSpaltenindex_1 As Byte
Dim parameterSpaltenindex_2 As Byte
Dim parameterSpaltenindex_3 As Byte
Dim parameterSpaltenindex_4 As Byte
Dim parameterSpaltenindex_5 As Byte
Dim parameterSpaltenindex_6 As Byte
Dim parameterSpaltenindex_7 As Byte
Dim mySumme As Single
Dim summeSpaltenindex As Byte
Dim IndexLetzteNichtleereZeile As Integer
anzahlSpalten = Bereich.Columns.Count
anzahlZeilen = Bereich.Rows.Count
mySumme = 0
On Error Resume Next
For intHelp = 1 To anzahlSpalten
If Bereich(1, intHelp) = ParameterName_1 Then parameterSpaltenindex_1 = intHelp
If Bereich(1, intHelp) = ParameterName_2 Then parameterSpaltenindex_2 = intHelp
If Bereich(1, intHelp) = ParameterName_3 Then parameterSpaltenindex_3 = intHelp
If Bereich(1, intHelp) = ParameterName_4 Then parameterSpaltenindex_4 = intHelp
If Bereich(1, intHelp) = ParameterName_5 Then parameterSpaltenindex_5 = intHelp
If Bereich(1, intHelp) = ParameterName_6 Then parameterSpaltenindex_6 = intHelp
If Bereich(1, intHelp) = ParameterName_7 Then parameterSpaltenindex_7 = intHelp
If Bereich(1, intHelp) = SummeSpalte Then summeSpaltenindex = intHelp
Next
For intHelp = 2 To anzahlZeilen
If Bereich(intHelp, parameterSpaltenindex_1) = ParameterWert_1 Or ParameterName_1 = "" _
Or ParameterWert_1 = alle Then
If Bereich(intHelp, parameterSpaltenindex_2) = ParameterWert_2 Or ParameterName_2 = _
"" Or ParameterWert_2 = alle Then
If Bereich(intHelp, parameterSpaltenindex_3) = ParameterWert_3 Or _
ParameterName_3 = "" Or ParameterWert_3 = alle Then
If Bereich(intHelp, parameterSpaltenindex_4) = ParameterWert_4 Or _
ParameterName_4 = "" Or ParameterWert_4 = alle Then
If Bereich(intHelp, parameterSpaltenindex_5) = ParameterWert_5 Or _
ParameterName_5 = "" Or ParameterWert_5 = alle Then
If Bereich(intHelp, parameterSpaltenindex_6) = ParameterWert_6 Or _
ParameterName_6 = "" Or ParameterWert_6 = alle Then
If Bereich(intHelp, parameterSpaltenindex_7) = ParameterWert_7 _
Or ParameterName_7 = "" Or ParameterWert_7 = alle Then
mySumme = mySumme + CSng(Bereich(intHelp, summeSpaltenindex) _
)
End If
End If
End If
End If
End If
End If
End If
Next
mySummewenn = mySumme
End Function
v