Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
980to984
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
980to984
980to984
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Makro geeignet für Sortierung?

Makro geeignet für Sortierung?
31.05.2008 22:48:00
Hugo
Hallo!
Eine Liste von Daten soll erst nach Spalten E,F,G,H,I sortiert werden. Eine zusätzliche Ausgabe als sortierte Liste wie im Screenshot ist nicht nötig, nur die Sortierung der unsortierten Liste.
Unter der sort. Liste soll dann wie im Screenshot ganz unten zu sehen folgendes stehen:
Nach Art jeweils die Summe aus Spalte I, wobei Spalte H mit Werten 1 und 0 angibt, was miteinander zu verrechnen ist.
Da diese Auswertung alle 2 bis 3 Tage ansteht und recht umfangreich ist, wollte ich mal wissen ob man dazu nicht ein makro benutzen könnte.
Grüsse, Hugo
Userbild

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro geeignet für Sortierung?
31.05.2008 22:54:49
Josef
Hallo Hugo,
mit einem Screenshot kann hier niemand etwas anfange. Lade eine Tabelle hoch aus der ersichtlich ist was du erreichen willst und wie du auf die Summen kommst.

Gruß Sepp



AW: Hier als Datei
31.05.2008 23:59:07
Josef
Hallo Hugo,
probier mal.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub SortAndSum()
Dim rng As Range, lngRow As Long, lngLast As Long, lngOutput As Long, lngI As Long
Dim dblSum As Double

With ActiveSheet
    lngLast = .Cells(1, 1).End(xlDown).Row
    lngOutput = lngLast + 6
    
    Set rng = .Range(.Cells(1, 1), .Cells(lngLast, 12))
    
    rng.Sort Key1:=.Cells(1, 8), Order1:=xlAscending, _
        Key2:=.Cells(1, 9), Order2:=xlAscending, _
        Header:=xlNo
    
    rng.Sort Key1:=.Cells(1, 5), Order1:=xlAscending, _
        Key2:=.Cells(1, 6), Order2:=xlAscending, _
        Key3:=.Cells(1, 7), Order3:=xlAscending, _
        Header:=xlNo
    
    .Cells(lngOutput, 1) = "AUSGABE:"
    lngOutput = lngOutput + 1
    lngRow = 1
    
    Do
        .Cells(lngOutput, 5) = .Cells(lngRow, 5)
        .Cells(lngOutput, 6) = .Cells(lngRow, 6)
        .Cells(lngOutput, 7) = .Cells(lngRow, 7)
        Do While .Cells(lngRow, 5) = .Cells(lngRow + lngI, 5) And .Cells(lngRow, 6) = .Cells(lngRow + lngI, 6) And .Cells(lngRow, 7) = .Cells(lngRow + lngI, 7)
            If .Cells(lngRow + lngI, 8) = 0 Then
                dblSum = dblSum - .Cells(lngRow + lngI, 9)
            Else
                dblSum = dblSum + .Cells(lngRow + lngI, 9)
            End If
            lngI = lngI + 1
        Loop
        .Cells(lngOutput, 9) = dblSum
        dblSum = 0
        lngOutput = lngOutput + 1
        lngRow = lngRow + lngI
        lngI = 0
    Loop While lngRow <= lngLast
    
End With
End Sub


Gruß Sepp



Anzeige
fast perfekt
01.06.2008 11:55:00
Hugo
Hallo Sepp,
danke!!!!
Habe aber selbst 2 falsche Angaben geliefert.
- Spalte A und K gibt es gar nicht, hatte ich zuviel angegeben.
- Die zu verrechnenden Werte aus somit Spalte H enthalten auch negative Werte (z.B. -15), diese werden in Spalte G zusätzl. mit der 0 angezeigt.
Gruss, Hugo

AW: fast perfekt
01.06.2008 17:40:31
Josef
Hallo Hugo,
na dann lade doch eine Tabelle hoch die dem Original entspricht.
Sonst Bastle ich da rum und am ende passt wieder etwas nicht.

Gruß Sepp



AW: fast perfekt
01.06.2008 19:57:59
Josef
Hallo Hugo,
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub SortAndSum()
Dim rng As Range, lngRow As Long, lngLast As Long, lngOutput As Long, lngI As Long
Dim dblSum As Double

With ActiveSheet
    lngLast = .Cells(1, 1).End(xlDown).Row
    lngOutput = lngLast + 6
    
    Set rng = .Range(.Cells(1, 1), .Cells(lngLast, 10))
    
    rng.Sort Key1:=.Cells(1, 7), Order1:=xlAscending, _
        Key2:=.Cells(1, 8), Order2:=xlAscending, _
        Header:=xlNo
    
    rng.Sort Key1:=.Cells(1, 4), Order1:=xlAscending, _
        Key2:=.Cells(1, 5), Order2:=xlAscending, _
        Key3:=.Cells(1, 6), Order3:=xlAscending, _
        Header:=xlNo
    
    .Cells(lngOutput, 1) = "AUSGABE:"
    lngOutput = lngOutput + 1
    lngRow = 1
    
    Do
        .Cells(lngOutput, 4) = .Cells(lngRow, 4)
        .Cells(lngOutput, 5) = .Cells(lngRow, 5)
        .Cells(lngOutput, 6) = .Cells(lngRow, 6)
        
        Do While .Cells(lngRow, 4) = .Cells(lngRow + lngI, 4) And _
                .Cells(lngRow, 5) = .Cells(lngRow + lngI, 5) And .Cells(lngRow, 6) = .Cells(lngRow + lngI, 6)
            
            dblSum = dblSum + .Cells(lngRow + lngI, 8)
            lngI = lngI + 1
            
        Loop
        
        .Cells(lngOutput, 8) = dblSum
        .Cells(lngOutput, 8).Interior.ColorIndex = .Cells(lngRow, 8).Interior.ColorIndex
        dblSum = 0
        lngOutput = lngOutput + 1
        lngRow = lngRow + lngI
        lngI = 0
        
    Loop While lngRow <= lngLast
    
End With

End Sub


Gruß Sepp



Anzeige
AW: fast perfekt
01.06.2008 23:39:54
Hugo
Hmm, jetzt hab ich den Code zwar im Editor, aber bekomme das Makro nicht unter Makro zu sehen.

AW: fast perfekt
02.06.2008 00:05:00
Josef
Hallo Hugo,
dann hast du es warscheinlich nicht in einem allgemeinen Modul abgelegt.

Gruß Sepp



AW: fast perfekt
02.06.2008 22:55:00
Hugo
Ja Sepp, kannst Du es auch so machen, daß in der AUSGABE dann ALLE Spalten mit angezeigt werden, nicht nur die mit den Suchkriterien? Ist dann übersichtlicher.

AW: fast perfekt
02.06.2008 23:12:00
Josef
Hallo Hugo,
Sub SortAndSum()
Dim rng As Range, lngRow As Long, lngLast As Long, lngOutput As Long, lngI As Long, lngC As Long
Dim dblSum As Double

With ActiveSheet
    lngLast = .Cells(1, 1).End(xlDown).Row
    lngOutput = lngLast + 6
    
    Set rng = .Range(.Cells(1, 1), .Cells(lngLast, 10))
    
    rng.Sort Key1:=.Cells(1, 7), Order1:=xlAscending, _
        Key2:=.Cells(1, 8), Order2:=xlAscending, _
        Header:=xlNo
    
    rng.Sort Key1:=.Cells(1, 4), Order1:=xlAscending, _
        Key2:=.Cells(1, 5), Order2:=xlAscending, _
        Key3:=.Cells(1, 6), Order3:=xlAscending, _
        Header:=xlNo
    
    .Cells(lngOutput, 1) = "AUSGABE:"
    lngOutput = lngOutput + 1
    lngRow = 1
    
    Do
        
        Do While .Cells(lngRow, 4) = .Cells(lngRow + lngI, 4) And _
                .Cells(lngRow, 5) = .Cells(lngRow + lngI, 5) And .Cells(lngRow, 6) = .Cells(lngRow + lngI, 6)
            
            dblSum = dblSum + .Cells(lngRow + lngI, 8)
            lngI = lngI + 1
            
        Loop
        
        For lngC = 1 To 10
            Select Case lngC
                Case 1 To 6, 9, 10
                    .Cells(lngOutput, lngC) = .Cells(lngRow, lngC)
                Case 8
                    .Cells(lngOutput, lngC) = dblSum
                    .Cells(lngOutput, lngC).Interior.ColorIndex = .Cells(lngRow, lngC).Interior.ColorIndex
                Case Else
            End Select
        Next
        
        dblSum = 0
        lngOutput = lngOutput + 1
        lngRow = lngRow + lngI
        lngI = 0
        
    Loop While lngRow <= lngLast
    
End With

End Sub


Gruß Sepp



Anzeige
AW: fast perfekt
03.06.2008 18:03:42
Hugo
Vielen Dank Sepp! Funktioniert prima.
Gruss, Hugo

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige