Thema: TotalList:=Array Argument | Herbers Excel-Forum

Hallo,

Sub Sortiere
ActiveCell.CurrentRegion.Sort _
Key1:=Range("I2"), Order1:=xlAscending, _
Key2:=Range("G2"), Order2:=xlAscending, _
Key3:=Range("A2"), Order3:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, _
DataOption3:=xlSortNormal
Selection.Subtotal GroupBy:=10, Function:=xlSum, TotalList:=Array(4, 11, 12 _
, 13, 14, 15), Replace:=True
End Sub

Gibt es die Möglichkeit bei diesem Makro das "TotalList:=Array" dynamisch zu bilden, dh. anstelle (4,11...bis 15) den Anfang und das Ende anders zu definieren?
Wäre schön ihr könntet mir helfen.
Grüße
Franz D.

Hallo Franz,
du könntest versuchen ein Array mit Spaltennummern zu erzeugen. Die Spaltennummern müsstest du dann z.B. durch suchen von Texten in den Spaltentiteln ermitteln.
Was meins du denn mit Ende und Anfang anders definieren?
Gruß
Franz
Beispiel:

Sub Sortiere()
Dim Titel As Range, arrSpalten() As Long, arrNamen, intI, intZeilen, Zelle As Range
arrNamen = Array("Feld01", "Feld03", "Feld07", "Feld08", "Feld13", "Feld12")
Set Titel = ActiveCell.CurrentRegion.Rows(1)
For intI = LBound(arrNamen) To UBound(arrNamen)
Set Zelle = Titel.Find(what:=arrNamen(intI), Lookat:=xlWhole, LookIn:=xlValues)
If Not Zelle Is Nothing Then
intZeilen = intZeilen + 1
ReDim Preserve arrSpalten(1 To intZeilen)
arrSpalten(intZeilen) = Zelle.Column
End If
Next
ActiveCell.CurrentRegion.Sort _
Key1:=Range("I2"), Order1:=xlAscending, _
Key2:=Range("G2"), Order2:=xlAscending, _
Key3:=Range("A2"), Order3:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, _
DataOption3:=xlSortNormal
If intZeilen > 0 Then
Selection.Subtotal GroupBy:=10, Function:=xlSum, TotalList:=arrSpalten, _
Replace:=True
End If
End Sub

Hallo Franz ,
Unter "Anfang" verstehe ich die 1.zu summierende Spalte, unter "Ende" die letzte, wonach alle Spalten in eine Reihenfolge komplett stehen. Beide Werte können immer wieder unterschiedlich sein. Es gäbe wahrscheinlich auch die Möglichkeit eine "WorksheetFunction.Subtotal" zu benutzen. Wie? Da müsste ich mich zuerst in den Recherchen durchboxen um die richtige Syntax zu finden. Ich werde dein Lösungvorschlag Morgen in Ruhe studieren. Er sieht vielversprechend aus.
Grüße von Franz D.

Hallo Franz,
Du warst richtig mit der "Dynamisierung" mittels Array-Technick. Ich werde die Materie "pauken". Habe durch "googleln" (auch "bingen") folgendes gefunden und für meine Zwecke angepasst:

Sub TotalList_dynamisch()'Quelle: http://www.xtremevbtalk.com/archive/index.php/t-261411.html
Dim aryTotalList()
Dim intColMax As Integer, intColNum As Integer, intColGroup As Integer, i As Integer
intColMax = 0
intColMax = Cells(1).CurrentRegion.Columns.Count 'Spaltenanzahl Insgesamt?
intColNum = 4           'ab wann soll summiert werden?
intColGroup = 9         'Welches Kriterium soll analysiert werden
i = 0
Do Until intColNum > intColMax
'aber die Spalten 5 bis 11 ignorieren mit dem "verpönten" Goto
If intColNum > 4 And intColNum < 12 Then GoTo Lbl_SkipColumn
i = i + 1
ReDim Preserve aryTotalList(1 To i)
aryTotalList(i) = intColNum 'Array TotalList dynamisch bilden
Lbl_SkipColumn:
intColNum = intColNum + 1
Loop
Cells(1, 1).Select
Selection.Subtotal GroupBy:=intColGroup, Function:=xlSum, TotalList:=aryTotalList, _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
End Sub

Ich hoffe andere "Suchenden" können dies verwenden oder noch optimieren.
Gute Nacht an die Community der Excellisten
Franz D.

Hallo Franz D.,
Goto ist nicht verpönt wenn es zweckmäßig ist.
In der gefundenen Lösung ist es nicht zweckmäßig. Man muss nur die If-Anweisung mit End If schließen oder hier das zweckmäßigere Select Case verwenden.
Gruß
Franz

'If-Anweisung schliessen
Do Until intColNum > intColMax
If intColNum > 4 And intColNum < 12 Then
i = i + 1
ReDim Preserve aryTotalList(1 To i)
aryTotalList(i) = intColNum 'Array TotalList dynamisch bilden
End If
intColNum = intColNum + 1
Loop
'oder mit der hier noch flexibler einsetzbaren Select Case Anweisung
Do Until intColNum > intColMax
Select Case intColNum
Case 4 To 12
i = i + 1
ReDim Preserve aryTotalList(1 To i)
aryTotalList(i) = intColNum 'Array TotalList dynamisch bilden
Case Else
'do nothing
End Select
intColNum = intColNum + 1
Loop

Guten Abend Franz,
Habe mittlerweile dein Select case integriert, einfach Spitze. Der Wald ist leider voller Bäume.
MERCI und Tschüss!
Franz D.