Thema Datum  Von Nutzer Rating
Antwort
08.01.2020 15:35:03 Tuncer
Solved
Blau verschachtelte foreach-Schleifen
08.01.2020 16:56:02 tscharl
Solved
08.01.2020 18:06:52 Tuncer
Solved
08.01.2020 18:16:44 Gast60458
Solved
08.01.2020 18:21:45 tscharl
Solved
08.01.2020 21:32:53 Gast78594
Solved
08.01.2020 21:43:43 tscharl
Solved
09.01.2020 12:05:32 Tuncer
Solved

Ansicht des Beitrags:
Von:
tscharl
Datum:
08.01.2020 16:56:02
Views:
499
Rating: Antwort:
 Nein
Thema:
verschachtelte foreach-Schleifen

Teil 1 gruppiert erst einmal nach Datum.

Wenn das passt, kann Teil 2 folgen (Else Abbruch).

Sub Tuncer_Teil_1()
    Dim wksQuelle As Worksheet
    Dim wks As Worksheet
    Dim i As Integer
    Dim Ueberschriften(4) As String
    Dim lngLetzteZeile As Long
    Dim lngZaehler As Long
    
    ' Überschriften ins Array
        Ueberschriften(0) = "Datum"
        Ueberschriften(1) = "String 1"
        Ueberschriften(2) = "String 2"
        Ueberschriften(3) = "String 3"
    
    ' Quellblatt kopieren
    Set wksQuelle = ThisWorkbook.Worksheets("Tabelle1")
    wksQuelle.Copy After:=Sheets(Sheets.Count)
    
    ' Zielblatt benennen und auswählen (ggf. unnötig)
    Sheets(Sheets.Count).Name = "Kopie" & Sheets.Count
    Set wks = Sheets("Kopie" & Sheets.Count)
    With wks
        .Select
        ' Zeilen Auswählen und nach Datum sortieren
        lngLetzteZeile = .Cells(Rows.Count, 1).End(xlUp).Row
        With .Sort
            .SortFields.Clear
            ' zunöchst nach Spalte A, danach nach Splate B sortieren
            .SortFields.Add2 Key:=Range("A2:A" & lngLetzteZeile), _
                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SortFields.Add2 Key:=Range("B2:B" & lngLetzteZeile), _
                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SetRange Range("A2:D" & lngLetzteZeile)
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        
        ' Zwischen den Zeilen jeder Datumsklasse eine Leere Zeile einfügen
        For lngZaehler = lngLetzteZeile To 3 Step -1
            If .Cells(lngZaehler, 1).Value <> .Cells(lngZaehler - 1, 1) Then
                Rows(lngZaehler).Select
                
                ' 1 Zeile einfügen, dabei Überschrift einsetzen
                Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                For i = 0 To 3
                    .Cells(lngZaehler, i + 1).Value = Ueberschriften(i)
                Next i
                
                ' 1 Trennzeile einfügen
                Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            End If
        Next lngZaehler
    End With
    Set wks = Nothing
    Set wksQuelle = Nothing
End Sub

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
08.01.2020 15:35:03 Tuncer
Solved
Blau verschachtelte foreach-Schleifen
08.01.2020 16:56:02 tscharl
Solved
08.01.2020 18:06:52 Tuncer
Solved
08.01.2020 18:16:44 Gast60458
Solved
08.01.2020 18:21:45 tscharl
Solved
08.01.2020 21:32:53 Gast78594
Solved
08.01.2020 21:43:43 tscharl
Solved
09.01.2020 12:05:32 Tuncer
Solved