Microsoft Excel

Herbers Excel/VBA-Archiv

TotalList:=Array Argument | Herbers Excel-Forum


Betrifft: TotalList:=Array Argument von: Franz D.
Geschrieben am: 29.11.2009 00:57:12

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.

  

Betrifft: AW: TotalList:=Array Argument von: fcs
Geschrieben am: 29.11.2009 16:26:23

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





  

Betrifft: AW: TotalList:=Array Argument von: Franz D.
Geschrieben am: 29.11.2009 21:23:02

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.


  

Betrifft: AW: TotalList:=Array Argument von: Franz D.
Geschrieben am: 29.11.2009 22:59:14

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.


  

Betrifft: AW: "verpöntes" Goto von: fcs
Geschrieben am: 30.11.2009 06:53:40

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



  

Betrifft: AW: TotalList dynamisch immer besser von: Franz D.
Geschrieben am: 30.11.2009 23:35:39

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