easy4breezy
Goto Top

Excel VBA Sortierung von Daten

Hallo,

ich muss in Excel Daten anhand der PLZ sortieren, vielleicht könnt ihr mir da helfen.


Name Vorname PLZ Ort Straße
NameUserA VornameUserA 11111 OrtUserA StraßeUserA
NameUserB VornameUserB 22222 OrtUserB StraßeUserB
NameUserC VornameUserC 11111 OrtUserC StraßeUserC


Es müsste alles in ein neues Tabellenblatt kopiert werden und dann in etwa so aussehen:


Name Vorname PLZ Ort Straße
NameUserA VornameUserA 11111 OrtUserA StraßeUserA
NameUserC VornameUserC 11111 OrtUserC StraßeUserC

Name Vorname PLZ Ort Straße
NameUserB VornameUserB 22222 OrtUserB StraßeUserB


Ganz am Ende sollen alle User mit der gleichen PLZ untereinander stehen und daraus müsste dann eine PDF erzeugt werden für jede PLZ.

Alle Versuche irgendwie etwas hinzubekommen sind leider kläglich gescheitert..
Ein Anfang wäre es die Sortierung hinzubekommen, die PDFs könnte man auch manuell erstellen, falls das nicht möglich ist.

Ich danke schon mal im Vorraus! face-smile

Content-Key: 322956

Url: https://administrator.de/contentid/322956

Ausgedruckt am: 19.03.2024 um 04:03 Uhr

Mitglied: MrCount
MrCount 05.12.2016 aktualisiert um 16:09:25 Uhr
Goto Top
Servus,

ähm, bin jetzt nicht sicher, ob ich das richtig verstanden habe....

Spalte markieren und dann in diesem Dialog "nach Größe sortieren" auswählen

2016-12-05 16_06_54-


und bei der "Sortierwarnung" die "Markierung erweitern"


2016-12-05 16_07_26-groove-musik


In ein anderes Tabellenblatt kopieren kann man vorher oder nachher.
Mitglied: 131381
131381 05.12.2016 aktualisiert um 16:11:01 Uhr
Goto Top
Spaltenfilter ?!

Excel-Makro

Gruß
Mitglied: MrCount
MrCount 05.12.2016 um 16:18:51 Uhr
Goto Top
Ok, sorry, da hatte ich wohl nicht bis zum Schluß gelesen.

Du willst das automatisiert haben und es soll auch automatisch exportiert werden...
Dann per (angepasstem) Makro, wie mikrotik schon verlinkt hat.
Mitglied: easy4breezy
easy4breezy 05.12.2016 um 17:18:05 Uhr
Goto Top
Habe es jetzt angespasst ein wenig.
Aus Spalte H werden die PLZ kopiert in ein neues Datenblatt "Data".
Dann werden die Duplikate gelöscht.

Aber irgendwie klappt es trotzdem nicht, es kommt bis zur Meldung fertig, aber ich finde in dem strExportPath keine Daten..
Ihr wisst bestimmt, was ich tun muss? face-smile

Sub Test()

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim Sortierspalte As String, Bereich As String, wsList As Worksheet, wsData As Worksheet, strExportPath As String, strFilename As String, fso As Object, intColumn As Integer

Rows("1:12").Select  
Selection.Delete Shift:=xlUp

Columns("J:O").Select  
Selection.Delete Shift:=xlToLeft

Bereich = "A:Z"  
Sortierspalte = "H"  
ActiveSheet.Range(Bereich).Sort _
Key1:=Range(Sortierspalte & "1"), Order1:=xlAscending, _  
Header:=xlGuess, MatchCase:=False, _
Orientation:=xlTopToBottom

Columns("H:H").Copy  
Sheets.Add.Name = "Data"  
Sheets("Data").Paste  
Application.CutCopyMode = False
ActiveCell.EntireRow.Insert
ActiveSheet.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes  


'Sheets festlegen  
Set wsList = Sheets("Data")  
Set wsData = Sheets("Sheet1")  

'Exportpfad für die Dateien  
strExportPath = "C:\Users\UserX\Desktop\Test\"  

'Objekte  
Set fso = CreateObject("Scripting.FileSystemObject")  

With wsList
    For Each cell In .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row)  
        'Wenn Name in der Liste noch nicht bearbeitet wurde ...  
        If cell.Value <> "" And cell.Offset(0, 1).Value = "" Then  
            With wsData
                'AutoFilter zurücksetzen  
                .UsedRange.AutoFilter
                
                'Lege Suchspalte fest je nachdem ob es eine Kundennummer(Numerisch) ist oder nicht (Name)  
                intColumn = IIf(IsNumeric(cell.Value), 3, 1)
                
                ' Nur wenn Daten des Users vorhanden  
                If Not (.Columns(intColumn).Find(cell.Value)) Is Nothing Then
                    'Filtere die Datentabelle anhand des Namens/Kundennummer  
                    .UsedRange.AutoFilter intColumn, cell.Value
                    
                    'Kopiere nur die Sichtbaren zellen der Liste  
                    .UsedRange.SpecialCells(xlCellTypeVisible).Copy
                    With Workbooks.Add
                        'Inhalt in neues WB einfügen  
                        .Sheets(1).Range("A1").PasteSpecial xlPasteValues  
                        'Spalten an Inhalt anpassen (optische Hilfe)  
                        .Sheets(1).UsedRange.EntireColumn.AutoFit
                        'Exportdateiname  
                        strFilename = strExportPath & "\" & cell.Value & ".xlsx"  
                        ' Wenn Datei noch nicht existiert Speichere und schließe das neue Workbook, ansonsten  
                        ' frage nach ob sie überschrieben werden soll  
                        If Not fso.FileExists(strFilename) Then
                            .SaveAs strFilename
                            .Close True
                        Else
                            If MsgBox("Datei '" & strFilename & "' existiert bereits. Soll sie überschrieben werden?", vbExclamation Or vbYesNo) = vbYes Then  
                                .SaveAs strFilename
                                .Close True
                            Else
                                .Close False
                            End If
                        End If
                    End With
                End If
            End With
            ' Notiere den Status des Namens in der Liste  
            cell.Offset(0, 1).Value = "Fertig."  
        End If
    Next
End With

'cleanup  
Set fso = Nothing

Application.DisplayAlerts = True
Application.ScreenUpdating = True

MsgBox "Fertig", vbInformation  


End Sub
Mitglied: 131381
131381 07.12.2016 aktualisiert um 16:37:11 Uhr
Goto Top
Wieso so viel Code wenn du das ganze doch total simpel mit einer Pivot-Tabelle machen kannst, für die ist Gruppieren ein Kinderspiel und alles automatisch:

screenshot

Die Ansicht kannst du nach Belieben anpassen.

Hier die Datei:
https://we.tl/4WlF8IZrZQ