Office: (Office 2013) Makro erstellen

Hallo,

ich bräuchte mal hier eure Hilfe:

Ich habe eine Tabelle mit 9 Spalten und 378531 Zeilen.
In Spalte 6 steht der Kundenname, der auch mehrmals vorkommt.

Ich hätte gerne, dass ich ein Tabellenblatt pro Kunden habe und dieses Tabellenblatt auch nach diesem benannt wird.
Bisher habe ich nur Lösungen gefunden, dass er mir zwar pro Kunden ein Tabellenblatt anlegt, aber da manche Kunden doppelt vorkommen, legt er mir dann auch mehrere Tabellenblätter an, quasi pro Zeile ein Blatt

Habt ihr eine Idee?
Auf das neue Tabellenblatt sollen selbstverständlich die anderen Spalten pro Kunde dann übernommen werden.

ich hoffe, dass ihr mir weiterhelfen könnt.

Vielen Dank.

Gruß
Jenne

 

Moinsens!

Ja, das ist in diesem Fall wohl nicht so ganz sinnvoll... ;-)

Der erste Ansatz, bevor man da was Neues gestaltet: Nimm doch mal diese "falsche" Lösung und passe sie an. Es wird irgendwo im Source ja die Stelle geben, an der ein neues Blatt (worksheets.add) angelegt wird. Das muß eigentlich nur mit einem IF-Konstrukt angepaßt werden, bei dem ein Blatt nur dann angelegt weird, wenn es nicht schon existiert.

Dann müßte geschaut werden, wo und wie der Cursor platziert wird, nachdem ein Blatt angelegt wurde. Z.B. wird bei einem neuen Blatt der Cursor auf A1 gesetzt. Das macht bei einem Blatt, auf dem schon Daten sind, natürlich keinen Sinn. Dort müßte der Cursor in Spalte A auf die erste freie Zeile gesetzt werden. (Der Cursor wird nicht unbedingt wirklich auf die Zelle platziert, aber es wird ziemlich sicher die eine oder andere Variable geben, die Zeile/Spalte der Position erhält.)

Code:

Blatt_anlegen( KundeName )
Cursor_platzieren( 1, 1 )

wird dann zu:

Code:

IF
    NOT Blatt_existiert( KundeName )
THEN
    Blatt_anlegen( KundeName )
    Cursor_platzieren( 1, 1 )
ELSE
    Cursor_platzieren( LetzteZeile + 1, 1 )
END IF

Die LetzteZeile kann man mit der End() Funktion von Excel bestimmen:

Code:

y = cells( rows.count, 1 ).end( xlup ).row

Und jetzt nur noch herausfinden, ob das Blatt mit dem Namen schon existiert:

Code:

Private Function blatt_existiert(sht$) As Boolean
    Dim result As Boolean
    Dim ws As Worksheet
    result = False
    For Each ws In Worksheets
        If (ws.Name = sht) Then
            result = True
        End If
    Next ws
    blatt_existiert = result
End Function

(Einfachster Ansatz... Bei sehr vielen Blättern in der Mappe würde ich eher eine WHILE Schleife über den numerischen Index nehmen, die bei "gefunden" abbricht = den Schleifenzähler auf worksheets.count setzt.)

Reicht das erstmal als Ansatz? Sonst müssen wir da doch eine ganze Ecke tiefer reingehen und es wird ev. einfacher, das neu aufzusetzen.

Gruß, Michael

 

Servus

erstmal vielen lieben Dank für deine Hilfe.
Ich bin jetzt nicht gerade das Makro-Genie.
Schreibe hin und wieder kleinere Dinge, hier verzweifel ich aber grad ...

Momentan mache ich das sogar händisch, das ich über Filter arbeite und dann die Daten rauskopiere :D

Ich habe mal eine Beispieldatei angehängt.
Ich hätte da jetzt beispielsweise gerne jeweils ein Tabellenblatt für Achim, Jochen usw.

Ich hoffe, du kannst mir weiterhelfen :)

Gruß
Jenne

 

Moinsens!

Ah, ok, kein Thema. Dann ist's doch einfacher, das neu aufzubauen.

Ich nehm mal Deine Beispiel-Mappe. Wenn Du dort einen Button einfügst und in das Code-Modul dann folgendes einkopierst:

Code:

Option Explicit

Private Function blatt_existiert(sht$) As Boolean

    Dim result As Boolean
    Dim ws As Worksheet
    
    result = False
    
    For Each ws In Worksheets
        If (ws.Name = sht) Then
            result = True
        End If
    Next ws
    
    blatt_existiert = result
    
End Function

Private Function Blatt_erzeugen(sht$) As Worksheet

    Dim result As Worksheet

    Set result = Worksheets.Add(after:=Worksheets(Worksheets.Count))
    result.Name = sht
    
    Set Blatt_erzeugen = result

End Function

Private Sub Blaetter_aufteilen()

    Dim s1 As Worksheet
    Dim y1 As Long
    Dim tst1 As String
    Dim nme1 As String
    Dim s2 As Worksheet
    Dim y2 As Long
    
    Set s1 = ActiveSheet
    
    y1 = 2
    tst1 = Trim$(s1.Cells(y1, 1).Value)
    While (tst1 <> "")
        nme1 = Trim$(s1.Cells(y1, 4).Value)
        
        If Not blatt_existiert(nme1) Then
            Set s2 = Blatt_erzeugen(nme1)
            s1.Rows(1).Copy Destination:=s2.Rows(1)
            y2 = 2
          Else
            Set s2 = Worksheets(nme1)
            y2 = s2.Cells(s2.Rows.Count, 1).End(xlUp).Row + 1
        End If
        
        s1.Rows(y1).Copy Destination:=s2.Rows(y2)
    
        y1 = y1 + 1
        tst1 = Trim$(s1.Cells(y1, 4).Value)
    Wend

End Sub

Private Sub CommandButton1_Click()

    Blaetter_aufteilen

End Sub

Dann erzeugt es Dir beim Button-Klick die Blätter mit den einzelnen Namen.

Achtung: 2x aufrufen erzeugt Fehler, weil er dann Blätter erzeugen will, die es schon gibt. Also vorher Blätter löschen. Die Fehler-Abfrage bzw. das Blattlöschen hab ich jetzt nicht eingebaut, um es erstmal übersichtlicher zu halten.

Gruß, Michael

 

Quark... Was schreib ich denn da? Keine Fehler, aber er würde die Daten einfach unten anhängen, also die Daten vervielfachen.

Gruß, Michael