Excel: Automatisch Arbeitsmappe erstellen + Indexiere

Ventrue

Neues Mitglied
Salü zämme,

Ich habe zwei Fragen, die ich am Besten als Beispiel stelle:

Ich habe eine Excel-Tabelle mit einer Spalte "Früchte", in dessen Zellen abwechselnd mal "Apfel", mal "Birne" und "Traube" stehen.

Nun möchte ich in einer neuen Spalte einen Art Index erstellen, in der für jede Frucht eine bestimmte Zahl stehen soll (z.B Apfel=1, Birne=2, Traube=3).

Dann möchte ich noch automatisch für jede Frucht eine neue Arbeitsmappe erstellen, dessen Name auch gleich der Name der Frucht sein soll. Also alle Zellen mit dem Text "Apfel" in eine neue Arbeitsmappe mit dem Namen "Apfel".


Ich hoffe mir kann da jemand helfen, ich komme selber nicht weiter und diese Arbeit von Hand zu machen, stinkt mir langsam.

Danke im Voraus!!!
 

Officer

Stammgast
Hallo Ventrue

Mein Vorschlag ist, dass Du Deine Tabelle nach Früchte sortierst. Damit kannst du dann einfach Deine Zahlen hinter die Früchte schreiben. Möchtest Du dann wirklich eine neue Arbeitsmappe erstellen oder nur eine neue Tabelle? Unabhängig davon: Wenn es nicht viele Früchte sind: Mach das doch von Hand.

Hilft das weiter?
 

1724

Stammgast
Hallo
Ich sehe das auch so wie officer. Am schnellsten ist mal wohl von Hand, ausser wir haben die Problemstellung falsch verstanden.

Die Nummerierung kannst du ja mit einer Sortierung, gem. Officer, mit einer wenn, dann, sonst-formel (falls nicht zu viele Früchte) oder mit diesem Makro machen:

Sub Apfel()
Range("A1").Select

Do While ActiveCell <> Empty

Select Case ActiveCell
Case "apfel"
ActiveCell.Offset(0, 1) = 1
Case "birne"
ActiveCell.Offset(0, 1) = 2
Case "traube"
ActiveCell.Offset(0, 1) = 3
End Select

ActiveCell.Offset(1, 0).Select
Loop

End Sub

Dieses Makro wäre noch erweiterbar, aber ich verstehe den Sinn und Zweck nicht ganz, wenn dann in einem neuen Worksheet oder Arbeitsblatt einfach 50 mal Apfel untereinander steht.

Vielleicht musst deine Idee nochmals genauer erklären bzw. die Dimension deines Vorhabens (1000 versch. Früchte).

greez
1724
 

mj10

Mitglied
Ich verstehe den Sinn auch nicht, das sollte jedoch universeller sein:

Code:
Sub Früchte()
zeile = 2
spalte = 1
Start = zeile
indcounter = 1
Columns("A:A").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Do While Cells(zeile, spalte) <> ""
        basesheet = ActiveSheet.Name
        If Cells(zeile, spalte) <> Cells(zeile + 1, spalte) Then
            ziel = zeile
            newname = Cells(zeile, spalte)
            Cells(indcounter + 5, spalte + 4) = newname & "="
            Cells(indcounter + 5, spalte + 5) = indcounter
            Cells(indcounter + 5, spalte + 4).Interior.ColorIndex = 6
            Cells(indcounter + 5, spalte + 5).Interior.ColorIndex = 6
            indcounter = indcounter + 1
            Range(Cells(Start, spalte), Cells(ziel, spalte)).Select
            Selection.Copy
            Sheets.Add
            ActiveSheet.Name = newname
            Cells(1, 1).Select
            ActiveSheet.Paste
            Range("A1").Select
            Sheets(basesheet).Select
        Else
        End If
        If ziel <> "" Then
            Start = ziel + 1
        Else
        End If
        zeile = zeile + 1
    Loop
Sheets(basesheet).Select
Range("A1").Select
End Sub

/Edit: der Index in der neuen Spalte war nicht eingebaut.
/Anmerkung: Es wird davon ausgegangen, dass Du eine Titelzeile hast (diese wird ignoriert) und die "Früchte" alle in Spalte A sind.
 
Zuletzt bearbeitet:

Ventrue

Neues Mitglied
Ich haba natürlich versucht mein Problem super einfach zu erklären.
Die Sache ist ich habe über 100 verschiedene "Früchte".
und ich erstell dann für jede Frucht eine eigene Arbeitsmappe, damit ich dann alle in einer Excell-Datei habe und nicht eben tausen verschiedene Dateien...
 

Ventrue

Neues Mitglied
@mj10:
Danke für den Makro, habs gleich ausprobiert. Leider versteh ich die Makrosprache nicht so gut.
Ich denke das mit den indexieren lass ich mal weg. Dann sollte er nicht einfach nur die Spalte kopieren, sondern auch die Infos in der ganzen Zeile, die zur "Frucht" gehört.
Ach und ich hab die "Früchte" in der Spalte B...

Was muss ich da noch ändern am Makro?
 

1724

Stammgast
Hallo
Ich habe mir erlaubt, das Markro von mj10 zu ändern. Ich hoffe, es entspricht nun deinen Vorstellungen.

Code:
Sub Test()
Range("B2").Select
zeile = 2
spalte = 2
Start = zeile
indcounter = 1
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Add Key:=ActiveCell, _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    Do While Cells(zeile, spalte) <> ""
        basesheet = ActiveSheet.Name
        If Cells(zeile, spalte) <> Cells(zeile + 1, spalte) Then
            ziel = zeile
            newname = Cells(zeile, spalte)
            indcounter = indcounter + 1
            Cells(zeile, spalte).Select
            ActiveCell.EntireRow.Select
            Selection.Copy
            Sheets.Add
            ActiveSheet.Name = newname
            Cells(1, 1).Select
            ActiveSheet.Paste
            Range("A1").Select
            Sheets(basesheet).Select
        Else
        End If
        If ziel <> "" Then
            Start = ziel + 1
        Else
        End If
        zeile = zeile + 1
    Loop
Sheets(basesheet).Select
Range("A1").Select
End Sub

Bemerkungen:
Basisdaten in "Tabelle1"
Beginn Spalte mit Früchten: B2

greez
1724
 
Zuletzt bearbeitet:
Oben