Tipps & Tricks
15.11.2014, 07:02 Uhr
Excel: Tabellennamen aus Namensliste per Makro
Sie haben eine Liste von Namen und sollten für jeden Namen eine neue Tabelle erstellen. Hier ein Makro, mit dem das automatisch klappt.
Lösung: Das Makro unseres Forumsbenutzers sortiert die Namen in der Liste alphabetisch und erzeugt danach pro Namen eine neue Tabelle. Es hängt eine fortlaufende Nummer an den Tabellennamen, damit es keine Probleme gibt, wenn es zwei «Hans Meiers» in Ihrer Liste gibt. Es fügt zudem in jeder neuen Tabelle auch gleich den selben Namen in Zelle A1 ein. Falls Sie das nicht wollen, entfernen Sie aus dem nachfolgenden Makrocode diese Zeile:
Code:
Range("A1") = vName.
Voraussetzungen: Die Namensliste steht in der ersten Spalte, beginnend bei A1 in einem ersten Tabellenblatt. Sie trägt keinen Spaltentitel; und wenn doch, wird dieser halt auch zu einer Tabelle. Drücken Sie Alt+F11 zum Öffnen des VisualBasic Editors. Klappen Sie «Microsoft Excel Objekte» auf und doppelklicken Sie auf DieseArbeitsmappe bzw. einfach die aktuelle Arbeitsmappe.
Kopieren Sie den folgenden Makrocode hinein - ohne die hier bloss der Markierung dienenden ****-Sternchen-Zeilen.
****
Code:
Sub NeueTabellen()
Dim nNamen ' Anzahl Namen in Spalte A
Dim tName ' Name der neuen Tabelle
Dim vName ' voller Name
Dim i ' Schleifenzähler
On Error GoTo fehler1
Dim nNamen ' Anzahl Namen in Spalte A
Dim tName ' Name der neuen Tabelle
Dim vName ' voller Name
Dim i ' Schleifenzähler
On Error GoTo fehler1
Application.ScreenUpdating = False
Sheets(1).Select
Cells.sort Key1:=Range("A1"), Order1:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Sheets(1).Select
Cells.sort Key1:=Range("A1"), Order1:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
nNamen = ActiveSheet.UsedRange.Rows.Count
For i = 1 To nNamen
tName = ActiveSheet.Cells(i, 1).Value
vName = tName ' voller Name
tName = Left(tName, 20) & "_" & i
tName = Left(tName, 20) & "_" & i
Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = tName
Range("A1") = vName ' fügt den vollen Namen in die jeweilige Tabelle ein
Sheets(1).Select
Next i
Application.ScreenUpdating = True
Exit Sub
tName = ActiveSheet.Cells(i, 1).Value
vName = tName ' voller Name
tName = Left(tName, 20) & "_" & i
tName = Left(tName, 20) & "_" & i
Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = tName
Range("A1") = vName ' fügt den vollen Namen in die jeweilige Tabelle ein
Sheets(1).Select
Next i
Application.ScreenUpdating = True
Exit Sub
fehler1:
MsgBox "Da gibts ein Problem!" & Chr(13) & _
"Sind die Tabellen etwa bereits vorhanden?"
Sheets(1).Select
Application.ScreenUpdating = True
Exit Sub
MsgBox "Da gibts ein Problem!" & Chr(13) & _
"Sind die Tabellen etwa bereits vorhanden?"
Sheets(1).Select
Application.ScreenUpdating = True
Exit Sub
End Sub
Nun können Sie das Makro einfach durch den Klick aufs grüne Play-Symbol (Dreieck mit Spitze nach rechts) starten. Schon werden die Tabellen mit den Namen erzeugt. Falls Sie keine Nummern hinter den Namen wollen, kürzen Sie diese Zeile:
Code:
tName = Left(tName, 20) & "_" & i
tName = Left(tName, 20) & "_" & i
auf diesen Inhalt:
Code:
tName = Left(tName, 20)
tName = Left(tName, 20)
Im folgenden Screenshot haben wir die Originalzeile durch ein Hochkomma auskommentiert und die selbe Zeile nochmals ohne die Nummerierungsanweisung eingefügt.
Es gibt noch ein zweites Makro. Jenes sorgt dafür, dass Sie im Tabellenblatt mit der Namensliste ganz simpel einen der Namen doppelklicken können, damit Excel direkt zur entsprechenden Tabelle springt. Hierfür müssen Sie das Makro aber nicht zur «Arbeitsmappe» hinzufügen, sondern zur Tabelle mit den Namen. Öffnen Sie hierfür den VisualBasic Editor, indem Sie Alt+F11 drücken. Klappen Sie in der linken Fensterhälfte allenfalls «Microsoft Excel Objekte» auf und doppelklicken Sie den Namen Ihrer Namenstabelle (z.B. «Tabelle1»). Damit wendet sich das Makro ausdrücklich in jener Tabelle an. Kopieren Sie folgenden Makro-Code hinein - wieder alles zwischen den ****Sternchen-Zeilen:
****
Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim nNamen ' Anzahl Namen
Dim tName ' Tabellen-Name
On Error GoTo fehler1
nNamen = ActiveSheet.UsedRange.Rows.Count
Set Target = Intersect(Target, Range(Cells(1, 1), Cells(nNamen, 1)))
If Target Is Nothing Then Exit Sub
tName = ActiveCell.Value
If IsEmpty(tName) Then Cancel = True: Exit Sub
Dim nNamen ' Anzahl Namen
Dim tName ' Tabellen-Name
On Error GoTo fehler1
nNamen = ActiveSheet.UsedRange.Rows.Count
Set Target = Intersect(Target, Range(Cells(1, 1), Cells(nNamen, 1)))
If Target Is Nothing Then Exit Sub
tName = ActiveCell.Value
If IsEmpty(tName) Then Cancel = True: Exit Sub
tName = Left(tName, 20) & "_" & ActiveCell.Row
Cancel = True
Sheets(tName).Select
Exit Sub
Cancel = True
Sheets(tName).Select
Exit Sub
fehler1:
Cancel = True
MsgBox "Sorry, ich glaube, es gibt keine" & Chr(13) & _
"Tabelle zu diesem Namen!"
Cancel = True
MsgBox "Sorry, ich glaube, es gibt keine" & Chr(13) & _
"Tabelle zu diesem Namen!"
End Sub
****
Führen Sie das Makro einmal aus. Danach sollte das mit dem Doppelklicken auf einen der Namen klappen. (PCtipp-Forum)
Kommentare
Es sind keine Kommentare vorhanden.