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
1184to1188
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
Inhaltsverzeichnis

Daten nach Datum sortieren (mehrere Kriterien)

Daten nach Datum sortieren (mehrere Kriterien)
mmmagic73@aol.de
Hallo Community,
Habe einen VBA Beispiel aus Internet (s.u.“ FalschSortiert“) nach Datum zu sortieren.
Möchte gern einige Spalten nach bestimmten Kriterien, nach K, J, I und B sortieren.
  • Sub FalschSortiert() Dim LRow As Integer 'Sortieren der Daten pro Tabellenblatt Dim sh As String Dim i As Integer LRow = Cells(Rows.Count, 2).End(xlUp).Offset(-1, 0).Row '*****AB HEIR WIRD FALSCH SORTIERT*** Range("B7", "K" & LRow + 1).Sort _ Key1:=Range("K7"), Order1:=xlAscending, _ Key2:=Range("I7"), Order1:=xlAscending, _ Key3:=Range("B7"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False Range(Cells(LRow + 2, 2), Cells(LRow + 10, 11)).ClearContents '*****FALSCH SORTIERT*** If LRow > 20 Then For i = 15 To LRow + 1 Cells(i, 7).Value = Cells(i, 6).Value + Cells(i, 5).Value + Cells(i - 1, 7).Value Next i Else For i = 7 To LRow + 1 Cells(i, 7).Value = Cells(i, 6).Value + Cells(i, 5).Value + Cells(i - 1, 7).Value Next i End If Application.ScreenUpdating = True End Sub

  • In meine Beispiels Mappe habe ich mehreren Tabellen;
    https://www.herber.de/bbs/user/72400.xls
    1-Tabelle „Beispiel“ so stehen die Daten drinnen
    2-Tabelle „FalschSortiert“ nach Ausführung der Makro“ FalschSortiert“ bekomme ich ungewollten Ergebnis in Tabelle
    A)Warum bekommt man keine Ergebnisse „I7:K97“(gelbe Markierung in Tabelle „FalschSortiert“ )?
    Spalte "B“ wurde auf Datum definiert.Was ist da falsch?
    3-Tabelle „Spalte B Manuell nachbessern“ da müsste ich jede einzelne Zeile von „B7:B97“ anklicken erst danach stehen die Formel in
    Zeilen Bereich „I7:K97“.
    4-in Tabelle „ So sollte sein“ ist meine gesuchte Lösung
    Wie konnte man den Code „FalschSortiert“ richtig anpassen?
    Es solle nach Spalten K, J, I und B sortieren werden und die mit Hilfe der Formel
  • If LRow > 20 Then
    For i = 15 To LRow + 1
    Cells(i, 7).Value = Cells(i, 6).Value + Cells(i, 5).Value + Cells(i - 1, 7).Value
    Next i
    Else
    For i = 7 To LRow + 1
    Cells(i, 7).Value = Cells(i, 6).Value + Cells(i, 5).Value + Cells(i - 1, 7).Value
    Next i
    End If

  • sollen auch die Werte in Spalte „G“ eingetragen werden.
    Habe selber mit Makro Recorder folgendes Code aufgenommen und den wollte ich an oberen Code anpassen leider erfolglos.
  • 
    Sub Makro1Test()
    ' Makro1Test Makro
    Range("B6:K146").Select
    Range("K6").Activate
    Application.CutCopyMode = False
    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range( _
    "B6:B146"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
    With ActiveSheet.Sort
    .SetRange Range("B5:K146")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
    End With
    If LRow > 20 Then
    For i = 15 To LRow + 1
    Cells(i, 7).Value = Cells(i, 6).Value + Cells(i, 5).Value + Cells(i - 1, 7).Value
    Next i
    Else
    For i = 7 To LRow + 1
    Cells(i, 7).Value = Cells(i, 6).Value + Cells(i, 5).Value + Cells(i - 1, 7).Value
    Next i
    End If
    Application.ScreenUpdating = True
    End Sub
    


  • Wenn Jemand von Euch eine Idee oder eine Lösung hat, wäre das für mich ein tolles Erlebnis.
    Danke im Voraus Daniel

    2
    Beiträge zum Forumthread
    Beiträge zu diesem Forumthread

    Betreff
    Benutzer
    Anzeige
    AW: Daten nach Datum sortieren (mehrere Kriterien)
    20.11.2010 10:14:33
    fcs
    Hallo Daniel,
    deine Probleme rühren wohl daher, das die Datenaus einer Quelle stammen, außer der Excel die Daten als Text übernimmt. Das gilt sowhl für das Datum im Spalte B als auch die Zahlenwerte in den Spalten E und F.
    Du solltest diese als erstes bereinigen, so dass Excel damit umgehen kann. Auch das Sortieren klappt dann.
    Außerdem solltest du Monat, Quartal und Jahr als Nummerische Werte ermitteln und nicht als Text. Oder hast du dafür besondere Gründe?
    Nachfolgend ein Makro zur Datums/Zahlen-Konversion und dein Sortiermakro geringfügig angepasst.
    Bei den im Sortiermakro angegebenen Zeilennummern kann ich allerdings zum Teil den Sinn nicht nachvollziehen.
    Gruß Franz
    Beispiel (2)

     ABCDEFGHIJK
    5#DatumDaten - Spalte CKategorieAusEinEinAusOKMonatQuartalJahr
    6124.01.2007Daten - Spalte CDaten - Spalte D-7,20 €   112007
    7224.02.2007Daten - Spalte CDaten - Spalte D-15,04 €   212007

    Formeln der Tabelle
    ZelleFormel
    I6=WENN(ISTFEHLER(MONAT(B6)); "";MONAT(B6))
    J6=WENN(ISTFEHLER(MONAT(B6)); "";AUFRUNDEN(MONAT(B6)/3;0))
    K6=WENN(ISTFEHLER(JAHR(B6)); "";JAHR(B6))
    I7=WENN(ISTFEHLER(MONAT(B7)); "";MONAT(B7))
    J7=WENN(ISTFEHLER(MONAT(B7)); "";AUFRUNDEN(MONAT(B7)/3;0))
    K7=WENN(ISTFEHLER(JAHR(B7)); "";JAHR(B7))


    Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
    Sub DatenAufbereiten()
    Dim Zeile1 As Long, ZeileL As Long, CalcStatus As Long
    Dim wks As Worksheet, Zelle As Range
    Set wks = ActiveSheet
    With wks
    Zeile1 = 6 '1. Zeile mit Daten
    ZeileL = .Cells.SpecialCells(xlCellTypeLastCell).Row
    With Application
    .ScreenUpdating = False
    .EnableEvents = False
    CalcStatus = .Calculation
    If CalcStatus  xlCalculationManual Then .Calculation = xlCalculationManual
    End With
    'Datum in Spalte B
    For Each Zelle In .Range(.Cells(Zeile1, 2), .Cells(ZeileL, 2))
    With Zelle
    If .Value = "" Then
    .ClearContents
    ElseIf IsDate(.Text) Then
    .Value = CDate(.Text)
    Else
    End If
    End With
    Next
    'Zahlenwerte in Spalten E, F und G
    For Each Zelle In .Range(.Cells(Zeile1, 5), .Cells(ZeileL, 7))
    With Zelle
    If .Value = "" Then
    .ClearContents
    ElseIf IsNumeric(.Text) Then
    Select Case .Column
    Case 5
    .Value = VBA.Abs(CDbl(.Text))
    Case Else
    .Value = CDbl(.Text)
    End Select
    Else
    End If
    End With
    Next
    .Calculate
    With Application
    .ScreenUpdating = True
    .EnableEvents = True
    If CalcStatus  .Calculation Then .Calculation = CalcStatus
    End With
    End With
    End Sub
    Sub FalschSortiert()
    Dim LRow As Integer     'Sortieren der Daten pro Tabellenblatt
    Dim sh As String
    Dim i As Integer
    LRow = Cells(Rows.Count, 2).End(xlUp).Offset(-1, 0).Row
    '*****AB HEIR WIRD FALSCH SORTIERT***
    Range("B5", "K" & LRow + 1).Sort _
    Key1:=Range("K5"), Order1:=xlAscending, _
    Key2:=Range("I5"), Order1:=xlAscending, _
    Key3:=Range("B5"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False
    Range(Cells(LRow + 2, 2), Cells(LRow + 10, 11)).ClearContents
    '*****FALSCH SORTIERT***
    If LRow > 20 Then
    For i = 15 To LRow + 1
    Cells(i, 7).Value = Cells(i, 6).Value + Cells(i, 5).Value + Cells(i - 1, 7).Value
    Next i
    Else
    For i = 7 To LRow + 1
    Cells(i, 7).Value = Cells(i, 6).Value + Cells(i, 5).Value + Cells(i - 1, 7).Value
    Next i
    End If
    Application.ScreenUpdating = True
    End Sub
    

    Anzeige
    AW: Daten nach Datum sortieren (mehrere Kriterien)
    21.11.2010 21:15:20
    mmmagic73@aol.de
    Hallo Franz,
    vielen Dank Franz für Deine Hilfe.
    Das stimmt die Spalten E und F habe ich leider übersehen.
    Den Formel
    "=WENN(ISTFEHLER(MONAT(B6)); "";MONAT(B6))"
    habe ich am Anfang übernommen.
    Später beim weiteren testen stellte ich fest das ich falsche Werte in Spalten I, J und K habe wen die Datums Spalte B leer ist.Dabei habe ich die Formel so angepasst;
    "=WENN(ODER(B6="";NICHT(ISTZAHL(B6)));"";WENN(ISTFEHLER(MONAT(B6));"";MONAT(B6)))".
    Ist es so OK?!
    Dein angepasste Makro "DatenAufbereiten" habe ich mehrmals getestet und bei mir wurde leider nicht sortiert wie gewünscht.
    Vielleicht habe ich mich nicht deutlich ausgedruckt.
    Zu angegebenen Zeilennummern in Spalte A - die sind nicht von mir.
    D.h. in Forum fand ich eine Daten Mappe mit vielen nutzlichen Beispielen. Aus diesen Beispielen wird was für mein individuellen Zweck gebastellt.
    Herber Forum finde ich Spitze da kann man von Euch Profis einiges lerenen.
    Zum sortieren habe ich noch einmal den aufgezeineten Makro nachgebessert.
    Ich suche nach Möglichkeit mit der Hilfe von VBA nach Datum in Spalten "B6:K" zu sorteieren.
    Bin mir nicht ganz sicher ob das Makro "sortieren" OK ist.
    Da ich mehrere Daten pro Spalten habe es soll nach Datum in Spalte B sortiert werden. Ich konnte dabei festellen das die restlichen ordnungsgemäß sortiert waren.
  • Sub sortieren()
    Dim wks As Worksheet
    Dim LRow As Integer     'Sortieren der Daten pro Tabellenblatt
    Dim sh As String
    Dim i As Integer
    LRow = Cells(Rows.Count, 2).End(xlUp).Offset(-1, 0).row
    Set wks = ActiveSheet
    With wks
    Range("B6:K160").Select
    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range("B6"), SortOn _
    :=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveSheet.Sort
    .SetRange Range("B6:K160")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
    End With
    End With
    If LRow > 5 Then
    For i = 7 To LRow + 1
    Cells(i, 7).Value = Cells(i, 6).Value - Cells(i, 5).Value + Cells(i - 1, 7).Value
    Next i
    Else
    For i = 7 To LRow + 1
    Cells(i, 7).Value = Cells(i, 6).Value - Cells(i, 5).Value + Cells(i - 1, 7).Value
    Next i
    End If
    End Sub
    


  • Dann aus Forum habe ich gelesen dass wenn die Daten mit Datum sortiert werden empfihlt sich mit eine Hilfsspalte (in meinen Fall sind I, J und K) zu arbeiten.
    Habe noch ein Makro der mir die Jahresberechnung ausrechnet daher benötige ich Monat, Quartal und das Jahr Spalte.
    Hier der orginale Makro;
  • Sub Auswerten_Click()
    Dim n As Integer      'Konto
    Dim i As Integer      'Ergebnisreihe
    Dim q As Integer      'Quartal
    Dim m As Integer      'Monat
    Dim Aus As Double     'Ausgaben
    Dim Ein As Double     'Einnahmen
    Dim bilanz As Double  'Gesamtsumme
    Dim row As Integer
    Dim Kategorie As String
    Dim jahr As Integer
    Dim sh_name As String
    Application.ScreenUpdating = False
    Kategorie = cmb_kategorie.Value
    jahr = cmb_jahr.Value
    n = 2
    i = 14
    bilanz = 0
    Range("A10:P50").ClearContents
    Range("A10:P50").ClearFormats
    Range("A10:P50").Font.Bold = True
    Range("A10:P50").Font.Size = 8
    ' Quartalsauswertung
    If ckb_quartal = True Then
    For n = 2 To 15
    sh_name = Sheets(n).Name
    q = 1
    For q = 1 To 4
    row = 6
    Aus = 0
    Ein = 0
    Do Until Sheets(n).Cells(row, 3).Value = ""
    If Sheets(n).Cells(row, 4).Value = Kategorie And Sheets(n).Cells(row, 11).Value =  _
    jahr And Sheets(n).Cells(row, 10).Value = q Then
    Aus = Aus + Sheets(n).Cells(row, 5).Value
    Ein = Ein + Sheets(n).Cells(row, 6).Value
    End If
    row = row + 1
    Loop
    If Aus  0 Then
    Cells(i, 3 + q).Value = Format(Aus + Ein, "#0")
    bilanz = bilanz + (Aus + Ein)
    End If
    Next q
    Cells(i, 8).Value = Cells(i, 4) + Cells(i, 5) + Cells(i, 6) + Cells(i, 7)
    If Cells(i, 8).Value  0 Then
    Cells(i, 3).Value = sh_name
    i = i + 1
    End If
    Next n
    Cells(11, 3) = "Bilanz pro Quartal für:  " & cmb_kategorie.Value
    Range(Cells(11, 2), Cells(11, 9)).Interior.ColorIndex = 15
    Cells(13, 3) = "Quartal"
    Cells(13, 8).Value = "Summe " & jahr
    q = 1
    For q = 1 To 4
    Cells(13, 3 + q).Value = "Q" & q
    Next q
    Cells(12, 4).Font.Bold = True
    Range(Cells(13, 3), Cells(i, 3)).HorizontalAlignment = xlRight
    Range(Cells(13, 4), Cells(i, 7)).HorizontalAlignment = xlCenter
    Range(Cells(13, 2), Cells(13, 9)).Borders(xlEdgeBottom).LineStyle = xlContinuous
    Range(Cells(14, 4), Cells(i, 7)).Font.Bold = False
    Cells(13, 8).HorizontalAlignment = xlLeft
    Cells(i + 2, 3).Value = "Gesamtbilanz:     " & Format(bilanz, "#0") & " EUR"
    Cells(i + 2, 3).HorizontalAlignment = xlLeft
    ChartObjects().Visible = False
    ' Monatsauswertung
    ElseIf ckb_monat = True Then
    For n = 2 To 15
    m = 1
    For m = 1 To 12
    row = 6
    Aus = 0
    Ein = 0
    Do Until Sheets(n).Cells(row, 3).Value = ""
    If Sheets(n).Cells(row, 4).Value = Kategorie And Sheets(n).Cells(row, 11).Value =  _
    jahr And Sheets(n).Cells(row, 9).Value = m Then
    Aus = Aus + Sheets(n).Cells(row, 5).Value
    Ein = Ein + Sheets(n).Cells(row, 6).Value
    End If
    row = row + 1
    Loop
    If Aus  0 Then
    Cells(i, 2 + m).Value = Format(Aus + Ein, "#0")
    Cells(i, 15) = Cells(i, 15) + Cells(i, 2 + m)
    bilanz = bilanz + (Aus + Ein)
    End If
    Next m
    If Cells(i, 15).Value  0 Then
    sh_name = Sheets(n).Name
    Cells(i, 2).Value = sh_name
    i = i + 1
    End If
    Next n
    For m = 1 To 12
    Cells(13, 2 + m).Value = m
    Cells(12, 2 + m).FormulaR1C1 = "=SUM(R[2]C:R[21]C)"
    Next m
    Cells(13, 2) = "Monat"
    Cells(13, 15).Value = "Summe " & jahr
    Cells(11, 2) = "Bilanz pro Monat für:  " & cmb_kategorie.Value
    Range(Cells(11, 2), Cells(11, 9)).Interior.ColorIndex = 15
    Range(Cells(13, 2), Cells(i, 2)).HorizontalAlignment = xlRight
    Range(Cells(13, 3), Cells(i, 15)).HorizontalAlignment = xlCenter
    Range(Cells(13, 1), Cells(13, 16)).Borders(xlEdgeBottom).LineStyle = xlContinuous
    Range(Cells(14, 3), Cells(i, 14)).Font.Bold = False
    Cells(13, 15).HorizontalAlignment = xlLeft
    Cells(11, 13).Value = "Gesamtbilanz:     " & Format(bilanz, "#0") & " EUR"
    Cells(11, 13).HorizontalAlignment = xlLeft
    Range(Cells(12, 3), Cells(12, 14)).Font.ColorIndex = 2
    ChartObjects().Visible = True
    End If
    Application.ScreenUpdating = True
    End Sub
    

  • Für weiter Vorschläge bin ich immer offen.
    Gruß Daniel
    Anzeige

    309 Forumthreads zu ähnlichen Themen

    Anzeige
    Anzeige
    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige