Datensätze auf Tabellenblätter verteilen

Forumthread: Datensätze auf Tabellenblätter verteilen

Jockel

Hallo,
ich habe in einer Excelmappe durch ein Makro Daten in eine Excelmappe gepumpt. Die Tabelle heißt "TEMP". Dieses Tabellenblatt beinhaltet praktisch alle meine Daten, beginnen ab Zeile 3 und betrifft die Spalten A - I.
Weiter habe ich ein zweites Tabellenblatt mit Name "Vorlage" in meiner Mappe.
Ich möchte nun folgendes erreichen:
In meinem Tabellenblatt "TEMP", wo alle Daten drin stehen, hat jeder Datensatz in der Spalte A ein Kürzel drin, zB:
A_______B_______C_______D_______E_______F_______G_______H_______I_____
AS______124_____1254____125_____5698____2587____263_____4578____4587__
AS______12554___1254____12544___1245____1254____458____2365____1254__
GT______1245____6543____12547___521_____1236____258____259_____1254___
HB______654_____214_____147______214____4125____4521___2587____1254___
AS______124____1458_____4875_____2155___1254____1269___1452____12547__
GT______1254___1256_____1236_____1254___4875____5874___8574_____8457__
usw.
Wichtig dabei, die Kürzel in der Spalte A können bei jedem Import anders heissen, sind also nie gleich.
Ich möchte nun per Makro alle Datensätze, die in der Spalte A das gleiche Kürzel haben, auf verschiedenen Tabellenblätter aufteilen. Also alle DS mit "AS" in der Spalte A sollen in ein Tabellenblatt, alle DS mit "GT" sollen in ein tabellenblatt usw.
Dazu soll das Blatt "Vorlage" dienen. Ich habe mir das so vorgestellt:
zB alle DS mit "AS" herausfiltern, von der Vorlage eine Kopie machen, die gefilterten Daten in das neue Tabellenblatt schreiben (ab Zeile3) und den vorhandenen Blattname "Vorlage" um "AS" erweitern (Nachher "VORLAGE AS") und dann unter diesem neuen Name abspeichern.
Dann die zweite Gruppe mit "GT" herausfiltern, von der Vorlage eine Kopie machen,die gefilterten Daten in das neue Tabellenblatt schreiben (ab Zeile3) und den vorhandenen Blattname "Vorlage" um "GT" erweitern (Nachher "VORLAGE GT") und dann unter diesem neuen Name abspeichern.
usw.
und das so lange, bis man alle Datensätze gruppiert hat.
Das große Problem dabei: ich weiß nie, wieviel Datensätze ich gesamt habe, und ich weiß nie, welche Kürzel und in welcher Anzahl kommen.
Kann man das irgend wie per Makro automatisieren ? Wäre mir eine große Hilfe. Vielleicht kann ja jemand weiter helfen, wie ich die daten gruppieren kann.
Danke mal
Joachim

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

AW: Datensätze auf Tabellenblätter verteilen

20.09.2010 18:49:54

ransi

HAllo Joachim
Versuch mal sowas:

Option Explicit

Public Sub test()
Dim objDic As Object
Dim rng As Range
Dim L As Long
Dim k As Range
Dim arr As Variant
Set rng = Sheets("Temp").Range("A1").CurrentRegion
Set objDic = CreateObject("Scripting.Dictionary")
For L = 1 To rng.Rows.Count
    Set objDic(rng(L, 1).Value) = make_Sure_workSheet_Exists("Vorlage " & Cells(L, 1))
    With objDic(rng(L, 1).Value)
        Set k = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
        arr = WorksheetFunction.Transpose(rng.Rows(L).Value)
        k.Resize(, UBound(arr)) = WorksheetFunction.Transpose(arr)
    End With
Next
End Sub

Public Function make_Sure_workSheet_Exists(strText As String) As Worksheet
On Error Resume Next
Set make_Sure_workSheet_Exists = Worksheets(strText)
If Err > 0 Then
    Err.Clear
    Sheets("Vorlage").Copy , Sheets(Sheets.Count)
    Set make_Sure_workSheet_Exists = Sheets(Sheets.Count)
    make_Sure_workSheet_Exists.Name = strText
End If
End Function

Das Blatt mit den Daten heisst Temp, und das Blatt Vorlage hast du ja sowieso...
ransi

ganz kleine Korrektur:

20.09.2010 19:02:36

ransi

HAllo

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Public Sub test()
Dim objDic As Object
Dim rng As Range
Dim L As Long
Dim k As Range
Dim arr As Variant
Set rng = Sheets("Temp").Range("A1").CurrentRegion
Set objDic = CreateObject("Scripting.Dictionary")
For L = 1 To rng.Rows.Count
    Set objDic(rng(L, 1).Value) = make_Sure_workSheet_Exists("Vorlage " & rng(L, 1))
    With objDic(rng(L, 1).Value)
        Set k = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
        arr = WorksheetFunction.Transpose(rng.Rows(L).Value)
        k.Resize(, UBound(arr)) = WorksheetFunction.Transpose(arr)
    End With
Next
End Sub

Public Function make_Sure_workSheet_Exists(strText As String) As Worksheet
On Error Resume Next
Set make_Sure_workSheet_Exists = Worksheets(strText)
If Err > 0 Then
    Err.Clear
    Sheets("Vorlage").Copy , Sheets(Sheets.Count)
    Set make_Sure_workSheet_Exists = Sheets(Sheets.Count)
    make_Sure_workSheet_Exists.Name = strText
End If
End Function

ransi

AW: ganz kleine Korrektur

20.09.2010 21:11:13

Jockel

Hallo ransi,
werds morgen testen. melde mich wieder.
Gruss
Joachim

AW: ganz kleine Korrektur:

21.09.2010 08:13:18

Jockel

Hallo ransi,
das funktioniert soweit sehr gut, Vielen, vielen Dank, ist echt klasse :-)
zwei Kleinigkeiten:
- was muss ich ändern, dass die Daten, wenn sie in die einzelnen Tabellenblätter geschrieben werden, nicht schon in der Zeile2, sondern erst ab Zeile 3 beginnen sollen. Ich möchte zwischen Überschrift und Daten eine Leerzeile.
- Kannst du noch ein paar Wörter Kommentar dazu schreiben, dass ich den Code auch verstehe :-))
Sonst vielen Dank
Joachim

AW: ganz kleine Korrektur:

21.09.2010 22:12:03

ransi

HAllo Jockel
Mit dem Dictionary war ich ganz weit über das Ziel hinausgeschossen.
Durch die Function make_sure_workSheet_Exists() ist das Dictionary so nützlich wie ein drittes ´Nasenloch.
Der Check ob das Blatt schon vorhanden ist macht ja die Function.
Schau mal ob das jetzt verstehst:

Option Explicit

Public Sub test()
Dim rng As Range
Dim L As Long
Dim k As Range
Dim arr As Variant
Dim WS As Worksheet
Set rng = Sheets("Temp").Range("A1").CurrentRegion
For L = 1 To rng.Rows.Count
    Set WS = make_Sure_workSheet_Exists("Vorlage " & rng(L, 1))
    With WS
        Set k = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0) 'Erste Freie Zelle in WS.Range("A:A")
        If k.Row = 2 Then Set k = k.Offset(1, 0)
        arr = WorksheetFunction.Transpose(rng.Rows(L).Value)
        k.Resize(, UBound(arr)) = WorksheetFunction.Transpose(arr)
    End With
Next
End Sub

Public Function make_Sure_workSheet_Exists(strText As String) As Worksheet
On Error Resume Next
Set make_Sure_workSheet_Exists = Worksheets(strText)
'Function läuft in einen Fehler wenn es das
'Sheet(strText) nicht gibt.
'Dann wird das Blatt"Vorlage" kopiert und umbenannt.
If Err > 0 Then
    Err.Clear
    Sheets("Vorlage").Copy , Sheets(Sheets.Count)
    Set make_Sure_workSheet_Exists = Sheets(Sheets.Count)
    make_Sure_workSheet_Exists.Name = strText
End If
End Function

ransi

Infobox / Tutorial

Excel-Daten auf mehrere Tabellenblätter verteilen

Schritt-für-Schritt-Anleitung
Häufige Fehler und Lösungen
Alternative Methoden
Praktische Beispiele
Tipps für Profis
FAQ: Häufige Fragen

Schritt-für-Schritt-Anleitung

Um deine Excel-Daten auf mehrere Tabellenblätter zu verteilen, kannst du folgendes Makro verwenden. Achte darauf, dass deine Daten in einem Tabellenblatt mit dem Namen "TEMP" stehen und du ein Blatt mit dem Namen "Vorlage" für die Verteilung hast.

Öffne den Visual Basic for Applications (VBA) Editor in Excel (Alt + F11).
Füge ein neues Modul hinzu (Rechtsklick auf „VBAProject“ > Einfügen > Modul).

Kopiere und füge den folgenden Code in das Modul ein:

Option Explicit

Public Sub test()
    Dim rng As Range
    Dim L As Long
    Dim k As Range
    Dim arr As Variant
    Dim WS As Worksheet
    Set rng = Sheets("Temp").Range("A1").CurrentRegion

    For L = 1 To rng.Rows.Count
        Set WS = make_Sure_workSheet_Exists("Vorlage " & rng(L, 1))
        With WS
            Set k = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
            If k.Row = 2 Then Set k = k.Offset(1, 0)
            arr = WorksheetFunction.Transpose(rng.Rows(L).Value)
            k.Resize(, UBound(arr)) = WorksheetFunction.Transpose(arr)
        End With
    Next
End Sub

Public Function make_Sure_workSheet_Exists(strText As String) As Worksheet
    On Error Resume Next
    Set make_Sure_workSheet_Exists = Worksheets(strText)
    If Err > 0 Then
        Err.Clear
        Sheets("Vorlage").Copy , Sheets(Sheets.Count)
        Set make_Sure_workSheet_Exists = Sheets(Sheets.Count)
        make_Sure_workSheet_Exists.Name = strText
    End If
End Function

Schließe den VBA-Editor und führe das Makro aus (Alt + F8).

Dieses Makro filtert die Datensätze in deiner "TEMP"-Tabelle und verteilt sie auf die jeweiligen Tabellenblätter, indem es den Namen des Blattes um das Kürzel aus der Spalte A erweitert.

Häufige Fehler und Lösungen

Fehler: "Blattname bereits vorhanden"
- Lösung: Der Code prüft bereits, ob das Blatt existiert. Stelle sicher, dass die Namen eindeutig sind.
Daten beginnen nicht in Zeile 3
- Lösung: Du kannst die Zeile, in der die Daten eingefügt werden, anpassen, indem du die Offset-Methode im Code änderst.

Alternative Methoden

Falls du kein Makro verwenden möchtest, kannst du auch die Filterfunktion in Excel nutzen. Markiere die Daten in deiner "TEMP"-Tabelle und benutze den Filter, um die Datensätze nach Kürzeln zu sortieren. Kopiere dann die gefilterten Daten manuell in die entsprechenden Tabellenblätter.

Praktische Beispiele

Angenommen, du hast folgende Daten in der "TEMP"-Tabelle:

A	B	C	D	E	F	G	H	I
AS	1	2	3	4	5	6	7	8
GT	1	2	3	4	5	6	7	8
AS	9	10	11	12	13	14	15	16

Nach dem Ausführen des Makros werden zwei neue Tabellenblätter erstellt: "Vorlage AS" und "Vorlage GT". Die Daten werden entsprechend aufgeteilt.

Tipps für Profis

Code anpassen: Wenn du zwischen der Überschrift und den Daten eine Leerzeile benötigst, ändere die Zeile If k.Row = 2 Then Set k = k.Offset(1, 0) in If k.Row = 2 Then Set k = k.Offset(2, 0).
Daten validieren: Füge eine Validierung ein, um sicherzustellen, dass die Daten korrekt aufgeteilt werden.

FAQ: Häufige Fragen

1. Wie kann ich das Makro speichern? Du kannst das Makro in einer Arbeitsmappe im .xlsm-Format speichern, um die VBA-Funktionen zu erhalten.

2. Was ist, wenn meine Daten in einer anderen Spalte beginnen? Du musst die Range-Anweisung im Code anpassen, um den Startpunkt deiner Daten zu ändern.

3. Kann ich das Makro für andere Tabellen verwenden? Ja, du kannst den Namen des Tabellenblatts in der Set rng-Anweisung anpassen, um das Makro auf andere Daten anzuwenden.

Beliebteste Forumthreads (12 Monate)

Datensätze auf Tabellenblätter verteilen

Forumthread: Datensätze auf Tabellenblätter verteilen

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial

Excel-Daten auf mehrere Tabellenblätter verteilen

Schritt-für-Schritt-Anleitung

Häufige Fehler und Lösungen

Alternative Methoden

Praktische Beispiele

Tipps für Profis

FAQ: Häufige Fragen

Beliebteste Forumthreads (12 Monate)

Datensätze auf Tabellenblätter verteilen

Forumthread: Datensätze auf Tabellenblätter verteilen

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Infobox / Tutorial

Excel-Daten auf mehrere Tabellenblätter verteilen

Schritt-für-Schritt-Anleitung

Häufige Fehler und Lösungen

Alternative Methoden

Praktische Beispiele

Tipps für Profis

FAQ: Häufige Fragen

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread