AW: Schleife bis neuer Tabellenblattname
07.02.2023 22:59:16
Zwenn
Hallo Susanne,
ich habe am Bier gerochen und mir beim durchsehen der Foren gedacht ... Ok, gucke ich mir Mal an. Ich habe es aber nicht ausprobiert und es fehlen auch die Prüfungen auf zu lange Tabellennamen (maximal 31 Zeichen), verbotene Zeichen in Tabellennamen (:\/?*[]) und die leere Zeichenkette as Name. Dafür gibt es aber keine Grenze nach oben, was mehrfache Tabellen in der Nummerierung angeht.
Einfach ausprobieren:
(Wie immer, mehr Kommentare als Code.)
Sub TabellenBenamung()
'Variablen
Dim tabelle As Worksheet 'Variable, um durch alle Tabellen zu iterieren
Dim tabellenNamen As Object 'Tabellennamen (keys) mit Zaehler (values) (wird ein Dictionary mit late binding)
Dim tabellenNameAusZelle As String 'Zellenbezug aus Spalte (Buchstabe) und Zeile (Zahl)
'Notwendige Initialisierungen von Variablen
Set tabellenNamen = CreateObject("Scripting.Dictionary") 'Dictionary fuer Tabellennamen und Zaehler
tabellenNameAusZelle = "A1" 'Zellenbezug
'Alle vorhandenen Tabellennamen in das Dictionary einlesen
'Denn es kann sein, dass die neue Benamung mit der bereits bestehenden kollidiert
'Die Tabellennamen dienen jeweils als Key
'Als Zaehler wird Value jeweils 1 gesetzt
'Sehr weitreichende Infos zu Dictionaries:
'https://excelmacromastery.com/vba-dictionary/
For Each tabelle In Sheets
'Alle Tabellen koennen ohne Pruefung ins Dict geschrieben werden,
'denn alle Namen sind auf jeden Fall eindeutig und gueltig
'Muster: dict.Add Key, Value
tabellenNamen.Add tabelle.Name, 1
Next tabelle
'Erneut alle Tabellen durchgehen und die endgueltigen Namen festlegen
For Each tabelle In Sheets
'Pruefen, ob aktueller Tabellenname schon im Dict vorhanden
'Muster: dict.Exists(Key)
If tabellenNamen.exists(tabelle.Name) Then
'Name ist bereits vorhanden
'Dann mit gleichem Namen und Nummer +1 neu festlegen
'
'Zunaechst den Zaehler um 1 erhoehen
tabellenNamen(tabelle.Name) = tabellenNamen(tabelle.Name) + 1
'Neuen Namen ins Register schreiben
tabelle.Name = tabellenNamen.Key & CStr(tabellenNamen(tabelle.Name))
Else
'Namen aus gewuenschter Zelle ins Register schreiben
tabelle.Name = tabelle.Range(tabellenNameAusZelle).Value
'Neuen Tabellennamen als Key in Dict eintragen
'Value auf 1 setzen
tabellenNamen.Add tabelle.Name, 1
End If
Next tabelle
End Sub
Dein Code hat mehr Fehler als richtige Zeilen ;-) Er läuft auch nicht einmal los, weil ein End If fehlt. Aber egal. Nicht benutzen, ist scheiße.
Viele Grüße,
Zwenn