Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1684to1688
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Tab Nummerieren

Tab Nummerieren
10.04.2019 13:32:46
Steve
Moin,
ich habe da noch eine Frage.
Per Klick wird bei mir ein neues Tabellenblatt erzeugt.
-(Durch kopieren einer Mastertabelle)
Derzeit wird nach der Nummer des Tabellenblatts gefragt und diese in eine Liste in dem Tabellenblatt "Startseite" eingetragen .
Jetzt dachte ich mir, es wäre doch sinnvoller, das VBA einfach prüft welche die nächste Freie Nummer ist und das neue Tabellenblatt automatisch danach benennen.
Die Schwierigkeit liegt darin das auch Tabellenblätter im Laufe der Zeit gelöscht werden. Es werden also auch wieder Nummern frei.
Leider habe ich derzeit noch keinen Plan wie ich das umsetzen soll. Kann mir da jemand helfen?
Horrido
Steve

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Tab Nummerieren
10.04.2019 15:05:05
Daniel
Hallo Steve,
die nächste freie Indexnummer für Tabellenblätter kannst du so ermitteln:
ThisWorkbook.Sheets.Count + 1
Bin mir nicht sicher, ob es das ist was du meinst?
Gruß
Daniel
AW: Tab Nummerieren
10.04.2019 15:59:10
UweD
Hallo
meinst du das so?
Sub Freie_Zahl()
    Dim i As Integer, j As Integer, z As Integer, Arr() As Integer
    Dim NName As String, Mmin As Integer, Mmax As Integer, Istda As Boolean
        
    For i = 1 To Sheets.Count
        NName = Sheets(i).Name
        
        If IsNumeric(NName) Then
            Redim Preserve Arr(z)
            Arr(z) = NName
            z = z + 1
        End If
    Next
    
    Mmin = Application.WorksheetFunction.min(Arr)
    Mmax = Application.WorksheetFunction.max(Arr)
    
    For i = Mmin To Mmax
        For j = Lbound(Arr) To Ubound(Arr)
            If Arr(j) = i Then
                Istda = True
                Exit For
            Else
                Istda = False
            End If
        Next j
        If Istda = False Then
            MsgBox "Frei ist Nr. " & i
            Exit Sub
        End If
 
    Next i
End Sub

LG UweD
Anzeige
upps
10.04.2019 16:02:32
UweD
letzte Zeile fehlte noch.
...
Next i
    MsgBox "Nächste Nr. ist " & Mmax + 1
End Sub

AW: upps
11.04.2019 16:13:47
Steve
Moin,
also zunächst. Das funktioniert super. Aber er soll den neuen Tab dann auch automatisch erstellen.
Ich habe bereits ein Makro das ein Mastertab kopiert. Derzeit wird als MSGBox abgefragt wie der Tab heissen soll.
Wenn ich das richtig verstehe müsste ich dein Makro doch nur vorneweg setzen, mit meinem Makro verbinden und aus deiner MSGBox die mir zum Schluss sagt welche die freie nummer ist eine Anweisung basteln die letztlich meine MSGBOX (die welche nach dem namen des Tabs fragt)ersetzt.
(Oje...ist noch verständlich was ich meine?)
Ist der Gedanke richtig soweit? Dann würde ich mich mal ans Werk machen, es selbst versuchen und das ergebnis senden.
Horrido
Steve
Anzeige
AW: upps
11.04.2019 16:40:13
UweD
Hallo
hab noch Kleinigkeiten geändert und das Blattkopieren eingebaut.
Sub Freie_Zahl()
    Dim i As Integer, j As Integer, z As Integer, Arr() As Integer
    Dim NName As String, Mmax As Integer, Istda As Boolean
        
    Dim TBM, Neu As Integer
    Set TBM = Sheets("Master") 'die MasterTab 
    
    For i = 1 To Sheets.Count
        NName = Sheets(i).Name
        
        If IsNumeric(NName) Then
            Redim Preserve Arr(z)
            Arr(z) = NName
            z = z + 1
        End If
    Next
    
    Mmax = Application.WorksheetFunction.Max(Arr)
    
    For i = 1 To Mmax
        For j = Lbound(Arr) To Ubound(Arr)
            If Arr(j) = i Then
                Istda = True
                Exit For
            Else
                Istda = False
            End If
        Next j
        If Istda = False Then
            Neu = i
            GoTo Neu
        End If
 
    Next i
    
Neu:
    TBM.Copy after:=Sheets(Sheets.Count)
    ActiveSheet.Name = IIf(Neu <> 0, Neu, Mmax + 1)
    MsgBox "Master kopiert in: " & ActiveSheet.Name
End Sub

LG UweD
Anzeige
AW: upps
15.04.2019 13:04:41
Steve
Moin UweD,
das funktioniert super.
Meine Masterfolie ist versteckt, wird aus und später wieder eingeblendet. Das bekomme ich hin.
Aber es wird vorausgesetzt das mindestens eine (Zahlen)Folie vorhanden ist. Letztlich ist das nur ein Schönheitsfehler. Aber ich frage mich wo ich ansetzen müsste wenn zunächst geprüft wird ob überhaupt eine (Zahlen)Folie vorhanden ist.
Insgesamt gibt es als dauerhaft eingeblendete Folie die "Startseite" welche jede Folie in Listenform ausgibt.
Es wäre also möglich die Datei mit genau 0 Folien zu beginnen (also 0 Zahlenfolien)
Nebenfrage: Dein Text enthält die Zeile: "Neu:"
Warum meckert VBA da nicht. Ist doch kein fester bestandteil des Codes, oder doch?
Horrido
Steve
Anzeige
AW: upps
15.04.2019 13:57:56
UweD
Hallo
dann so...
Sub Freie_Zahl()
    Dim i As Integer, j As Integer, z As Integer, Arr() As Integer
    Dim NName As String, Mmax As Integer, Istda As Boolean
    Dim TBM, TBN, Neu As Integer, ZB As Boolean
    
    Set TBM = Sheets("Master") 'die MasterTab 
    
    For i = 1 To Sheets.Count
        NName = Sheets(i).Name
        
        If IsNumeric(NName) Then
            Redim Preserve Arr(z)
            Arr(z) = NName
            z = z + 1
            ZB = True
        End If
    Next
    
    If ZB = False Then
        MsgBox "Kein Zahlenblatt vorhanden"
        Exit Sub
    End If
    
    Mmax = Application.WorksheetFunction.Max(Arr)
    
    For i = 1 To Mmax
        For j = Lbound(Arr) To Ubound(Arr)
            If Arr(j) = i Then
                Istda = True
                Exit For
            Else
                Istda = False
            End If
        Next j
        If Istda = False Then
            Neu = i
            GoTo Weiter
        End If
 
    Next i
    
Weiter:
    With TBM
        .Visible = True
        .Copy after:=Sheets(Sheets.Count)
        .Visible = False
    End With
    With ActiveSheet
        .Name = IIf(Neu <> 0, Neu, Mmax + 1)
        MsgBox "Master kopiert in: " & .Name
    End With
End Sub
zu Neu:)
ist in dem Fall eine Sprungmarke. (Goto Neu)
zugegeben unglücklich gewählt, da es ja auch eine Variable darstellt.
habs geändert
Anzeige
AW: upps
16.04.2019 13:22:57
Steve
Moin UweD,
das ist ja merkwürdig. In meiner Testdatei funktioniert das super. Ich habe die Startseite eingeblendet. Die Master ist ausgeblendet und es gibt noch kein Zahlentab.
Der Neue Tab wird die 1
Übertrage ich das in meine eigentliche Datei funktioniert es aber nicht mehr. Die Startseite ist eingeblendet. Die Master ausgeblendet und noch kein Zahlentab. Dann kommt auf einmal
MsgBox "Kein Zahlenblatt vorhanden"
Aber eigentlich sollte er doch mit 1 beginnen wenn überhaupt kein Zahlentab vorliegt. Liegt das vielleicht daran das auch noch andere Tabs ausgeblendet vorliegen. (sind aber keine Zahlentabs.)
Habe ich da was falsch gemacht beim übertragen?
Horrido
Steve
Anzeige
AW: upps
16.04.2019 14:22:34
UweD
das ist ja merkwürdig. In meiner Testdatei funktioniert das super. Ich habe die Startseite eingeblendet. Die Master ist ausgeblendet und es gibt noch kein Zahlentab.
Der Neue Tab wird die 1

Das kann nicht sein. dann gibt es evtl eins was "0" heißt oder "Bindestrich 10" (also -10)...
Wenn KEIN Zahlenblatt da ist, dann kommt die MSGBOX
Genau so wolltest du es. Du hattest geschrieben:
Aber es wird vorausgesetzt das mindestens eine (Zahlen)Folie vorhanden ist. Letztlich ist das nur ein Schönheitsfehler. Aber ich frage mich wo ich ansetzen müsste wenn zunächst geprüft wird ob überhaupt eine (Zahlen)Folie vorhanden ist.
Wenn es eins gibt, was z.b. 0 wäre, oder &GT1 dann würde die 1 als Neues vorgeschlagen
Anzeige
AW: upps
16.04.2019 15:27:01
Steve
Hallo,
okay. Das war sehr unpräzise von mir.
Ich präzisiere:
Ganz zu Anfang wird lediglich die Startseite zu sehen sein. Von dort wird das Makro bei Klick gestartet. Es sollte nun die Folie Nummer 1 entstehen. In Folge entstehen dann alle weiteren Folien. Einmal gestartet ist es eher unwahrscheinlich das alle Zahlentabs gelöscht werden.
Ich habe überlegt ob ich das selber hinbekomme aber ich kann derzeit deinen Code nur bedingt verstehen.
Liege ich richtig das der entscheidende Punkt irgendwo hier liegt:
If IsNumeric(NName) Then
ReDim Preserve Arr(z)
Arr(z) = NName
z = z + 1
ZB = True
End If
Wäre schön du könntest mir da noch einmal aushelfen.
Liebe Grüße
Steve
Anzeige
AW: upps
16.04.2019 16:11:12
UweD
HAllo nochmal

1. If IsNumeric(NName) Then
2.    ReDim Preserve Arr(z)
3.    Arr(z) = NName
4.    z = z + 1
5.    ZB = True
6. End If

in 1)
- wird geprüft, ob der Tabellenblattname eine Zahl ist
in 2)
- wird das Array dann auf eine neue Länge dimensioniert (auf die Länge Z),
- Preseve: Bestehende Einträge werden NICHT verworfen
- im ersten Durchlauf ist z noch 0, das ist aber ok, da Arrays auch mit (0) starten
in 3)
- wird dann die neue Zahl eingetragen also in Arr(0)
in 4)
- wird der Zähler für den nächsten Durchlauf um eins erhöht.
in 5)
- wird dann festlegt, dass mind ein Blatt eine Zahl ist
usw.


Wenn ich das richtig verstanden habe, dann müsste das hier deine Lösung sein.
- Wenn noch keine Zahl vorhanden ist, dann wird bei 1 begonnen
- Sind Zahlen da, wird ab 1 geschaut, ob bis zur Höchsten eine Lücke vorhanden ist
- sonst wird die höchste Zahl plus 1 verwendet
Sub Freie_Zahl()
    Dim i As Integer, j As Integer, z As Integer, Arr() As Integer
    Dim NName As String, Mmax As Integer, Istda As Boolean
    Dim TBM, TBN, Neu As Integer, ZB As Boolean
    
    Set TBM = Sheets("Master") 'die MasterTab 
    
    For i = 1 To Sheets.Count
        NName = Sheets(i).Name
        
        If IsNumeric(NName) Then
            Redim Preserve Arr(z)
            Arr(z) = NName
            z = z + 1
            ZB = True
        End If
    Next
    
    
    If ZB Then
        Mmax = Application.WorksheetFunction.Max(Arr)
    
       For i = 1 To Mmax
           For j = Lbound(Arr) To Ubound(Arr)
               If Arr(j) = i Then
                   Istda = True
                   Exit For
               Else
                   Istda = False
               End If
           Next j
           If Istda = False Then
               Neu = i
               GoTo Weiter
           End If
    
       Next i
    End If
Weiter:
    With TBM
        .Visible = True
        .Copy after:=Sheets(Sheets.Count)
        .Visible = False
    End With
    With ActiveSheet
        .Name = IIf(Neu <> 0, Neu, Mmax + 1)
        MsgBox "Master kopiert in: " & .Name
    End With
End Sub
LG UweD
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige