Microsoft Excel

Herbers Excel/VBA-Archiv

Inhaltsverzeichnis Tabellenblätter automatisc

Betrifft: Inhaltsverzeichnis Tabellenblätter automatisc von: Chris
Geschrieben am: 10.11.2014 16:42:55

Hallo,
hab wieder mal ne Frage.
Ich habe eine umfangreiche Excel-Datei mit vielen Arbeitsblättern.
Es sind in der Hauptsache 3 verschiedene Sheets, die mit "Agenda_", "MoM_" und "AcRep_" beginnen und dann folgt jeweils ein Datum.
Kann ich eine Art Inhaltsverzeichnis automatisch generieren, bei der dann in 3 Spalten jeweils untereinander die Tabellenblätter zu jedem Sheet stehen mit Hyperlink, mit dem ich direkt zu dem Sheeet springen kann?

Es sollte so aussehen - nebeneinander und jeweils sortiert mit dem aktuellesten Datum als erstes:
(Krieg es leider im Editor hier nicht nebeneinander dargestellt)

Spalte A:
Agenda_01.12.2014
Agenda_01.10.2014
...

Spalte B:
MoM_01.11.2014
MoM_15.10.2014
...

Spalte C:
AcRep_05.12.2014
AcRep_07.09.2014
...

Ich habe zwar schon verschiedene Lösungen im Internet gefunden, daber die listen immer ALLE Tabellenblätter auf.
Das Ganze soll dann jedesmal bei Anklicken des Sheets "Übersicht" neu generiert werden, beginnend immer ab Zeile 5 (darüber soll noch Text stehen).
Ich hoffe, es ist verständlich erklärt.

Danke schon mal vorab.
Chris

  

Betrifft: AW: Inhaltsverzeichnis Tabellenblätter automatisc von: fcs
Geschrieben am: 10.11.2014 17:45:54

Hallo Chris,

die Sortierung nach dem Datum macht die Sache etwas komplizierter.

Zum Sortieren wird das Datum immer jeweils zeitweise in Spalte D eingetragen.

Gruß
Franz

'Code unter dem Tabellenblatt "Übersicht"
Private Sub Worksheet_Activate()
  'Inhaltsverzeichnis für bestimmte Blätter erstellen
  Dim Zeile As Long, Zeile_Max As Long
  Dim Spalte As Long, Spalte_Datum As Long
  Dim arrBlatt, intBlatt As Integer
  Dim wksUeb As Worksheet, wks As Worksheet
  Dim strDatum As String
  arrBlatt = Array("Agenda_", "Mom_", "AcRep_")
  
  Set wksUeb = Worksheets("Übersicht") 'Name ggf anpassen
  Spalte_Datum = 4
  With wksUeb
    With .UsedRange
    Zeile_Max = .Row + .Rows.Count
    End With
    If Zeile_Max >= 5 Then
      .Range(.Rows(5), .Rows(Zeile_Max)).ClearContents ' oder .Clear
    End If
    Spalte = 0
    For intBlatt = LBound(arrBlatt) To UBound(arrBlatt)
      Spalte = Spalte + 1
      Zeile = 4
      For Each wks In ActiveWorkbook.Worksheets
        If UCase(Left(wks.Name, Len(arrBlatt(intBlatt)))) = UCase(arrBlatt(intBlatt)) Then
          Zeile = Zeile + 1
          .Cells(Zeile, Spalte) = wks.Name
          strDatum = Right(wks.Name, 10)
          strDatum = Right(strDatum, 4) & "-" & Mid(strDatum, 4, 2) & "-" & Left(strDatum, 2)
          If IsDate(strDatum) Then
            .Cells(Zeile, Spalte_Datum).Value = CDate(strDatum)
          Else
            .Cells(Zeile, Spalte_Datum).Value = "'" & Right(wks.Name, 10)
          End If
          .Hyperlinks.Add Anchor:=.Cells(Zeile, Spalte), Address:="", _
              SubAddress:=wks.Name & "!A2", TextToDisplay:=wks.Name
        End If
      Next wks
      If Zeile > 5 Then
        With .Range(.Cells(5, Spalte), .Cells(Zeile, Spalte_Datum))
          .Sort key1:=.Cells(1, Spalte_Datum - Spalte + 1), Order1:=xlDescending, _
                Header:=xlNo
        End With
      End If
      With .Range(.Cells(5, Spalte_Datum), .Cells(Zeile, Spalte_Datum))
        .Clear
      End With
    Next intBlatt
  End With
  
End Sub



  

Betrifft: AW: Inhaltsverzeichnis Tabellenblätter automatisc von: Chris
Geschrieben am: 10.11.2014 18:17:48

Hi Franz,
genial, einfach nur genial.
Funktioniert einwandfrei und genau so wie ich es haben wollte.
Vielen Dank für die schnelle und tolle Hilfe. Ihr seid einfach Spitze !!
Ich hab noch ne Frage dazu:
Ist es auf einfache Weise noch möglich, statt "MoM_10.11.2014" "Minutes of Meeting_10.11.2014" und statt "AcRep_10.11.2014" "Action Report_10.11.2014" ausgeben zu lassen?
Wenn es zu aufwändig ist, bin ich mit dem jetzigen Ergebnis auch zufrieden.

Grüße
Chris.


  

Betrifft: AW: Inhaltsverzeichnis Tabellenblätter automatisc von: fcs
Geschrieben am: 11.11.2014 08:24:58

Hallo Chris,

hier das Makro mit Ersetzen der abgekürzten Blattnamen durch Langname.

Gruß
Franz

'Code unter dem Tabellenblatt "Übersicht"
Private Sub Worksheet_Activate()
  'Inhaltsverzeichnis für bestimmte Blätter erstellen
  Dim Zeile As Long, Zeile_Max As Long
  Dim Spalte As Long, Spalte_Datum As Long
  Dim arrBlatt, intBlatt As Integer
  Dim wksUeb As Worksheet, wks As Worksheet
  Dim strDatum As String, strName As String
  arrBlatt = Array("Agenda_", "Mom_", "AcRep_")
  
  Set wksUeb = Worksheets("Übersicht") 'Name ggf anpassen
  Spalte_Datum = 4
  With wksUeb
    With .UsedRange
    Zeile_Max = .Row + .Rows.Count
    End With
    If Zeile_Max >= 5 Then
      .Range(.Rows(5), .Rows(Zeile_Max)).ClearContents ' oder .Clear
    End If
    Spalte = 0
    For intBlatt = LBound(arrBlatt) To UBound(arrBlatt)
      Select Case arrBlatt(intBlatt)
        Case "Agenda_": strName = "Agenda_"
        Case "Mom_": strName = "Minutes of Meeting_"
        Case "AcRep_": strName = "Action Report_"
      End Select
      Spalte = Spalte + 1
      Zeile = 4
      For Each wks In ActiveWorkbook.Worksheets
        If UCase(Left(wks.Name, Len(arrBlatt(intBlatt)))) = UCase(arrBlatt(intBlatt)) Then
          Zeile = Zeile + 1

          strDatum = Right(wks.Name, 10)
          strDatum = Right(strDatum, 4) & "-" & Mid(strDatum, 4, 2) & "-" & Left(strDatum, 2)
          If IsDate(strDatum) Then
            .Cells(Zeile, Spalte_Datum).Value = CDate(strDatum)
          Else
            .Cells(Zeile, Spalte_Datum).Value = "'" & Right(wks.Name, 10)
          End If
          .Hyperlinks.Add Anchor:=.Cells(Zeile, Spalte), Address:="", _
              SubAddress:=wks.Name & "!A2", TextToDisplay:=""
          .Cells(Zeile, Spalte).Value = strName & Right(wks.Name, 10)
        End If
      Next wks
      If Zeile > 5 Then
        With .Range(.Cells(5, Spalte), .Cells(Zeile, Spalte_Datum))
          .Sort key1:=.Cells(1, Spalte_Datum - Spalte + 1), Order1:=xlDescending, _
                Header:=xlNo
        End With
      End If
      With .Range(.Cells(5, Spalte_Datum), .Cells(Zeile, Spalte_Datum))
        .Clear
      End With
    Next intBlatt
  End With
  
End Sub



  

Betrifft: AW: Inhaltsverzeichnis Tabellenblätter automatisc von: Chris
Geschrieben am: 11.11.2014 08:53:12

Hi Franz,
funktioniert aufs 1. Mal. Vielen Dank. Ihr seid die Besten.
Ich habe noch ein anderes Problem, da geht es um das Ansprechen des Menüpunktes Daten/Verknüpfung bearbeiten mittels einer Befehlsschaltfläche. Ich finde nirgends den Code dafür. Kennst du dich damit aus?
Vielen Dank nochmals.
Chris


  

Betrifft: AW: Inhaltsverzeichnis Tabellenblätter automatisc von: fcs
Geschrieben am: 11.11.2014 10:26:47

Hallo Chris,

nach einigen Rumsuchen hab ich die Konstante für den entsprechenden Dialog gefunden.

Gruß
Franz

Sub Dialog_Verknuepfung_bearbeiten()
  Application.Dialogs(xlDialogOpenLinks).Show
End Sub



  

Betrifft: AW: Inhaltsverzeichnis Tabellenblätter automatisc von: Chris
Geschrieben am: 11.11.2014 11:17:29

Hallo Franz,
echt super, Danke dir.
Damit habt ihr mir wirklich geholfen.
Gruß Chris


  

Betrifft: AW: Inhaltsverzeichnis Tabellenblätter automatisc von: Michael
Geschrieben am: 10.11.2014 18:20:41

Hallo Chris!

Spannende Sache, ein (fehlerhafter) Ansatz - werde morgen weiter tüfteln - von mir:

Sub InhaltstabelleAnlegen()

    Dim tblInhalt, tblSheet As Worksheet
    Dim intTabellen As Integer
    Dim intZeilenA As Integer
    Dim intZeilenB As Integer
    Dim intZeilenC As Integer
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    For Each tblSheet In ActiveWorkbook.Sheets
        
        If tblSheet.Name = "Inhaltsverzeichnis" Then
            tblSheet.Delete
        End If
    
    Next tblSheet
    
    Application.DisplayAlerts = True
    
    Set tblInhalt = Worksheets.Add(before:=Worksheets(1))
    
    With tblInhalt
    .Name = "Inhaltsverzeichnis"
    End With
    
    intZeilenA = 5
    intZeilenB = 5
    intZeilenC = 5
    
    For intTabellen = 2 To ActiveWorkbook.Worksheets.Count
        
        Select Case True
        
            Case Worksheets(intTabellen).Name Like "Agenda_*"
            
                tblInhalt.Cells(intZeilenA, 1).Value = Worksheets(intTabellen).Name
    
                tblInhalt.Cells(intZeilenA, 1).Hyperlinks.Add _
                Anchor:=tblInhalt.Cells(intZeilenA, 1), Address:="", SubAddress:= _
                "'" & Worksheets(intTabellen).Name & "'!A1", _
                ScreenTip:="Klicken Sie um zur Tabelle zu gelangen", _
                TextToDisplay:=Worksheets(intTabellen).Name
                
                intZeilenA = intZeilenA + 1
            
            Case Worksheets(intTabellen).Name Like "MoM*"
            
                tblInhalt.Cells(intZeilenB, 2).Value = Worksheets(intTabellen).Name
    
                tblInhalt.Cells(intZeilenB, 2).Hyperlinks.Add _
                Anchor:=tblInhalt.Cells(intZeilenB, 1), Address:="", SubAddress:= _
                "'" & Worksheets(intTabellen).Name & "'!A1", _
                ScreenTip:="Klicken Sie um zur Tabelle zu gelangen", _
                TextToDisplay:=Worksheets(intTabellen).Name
                
                intZeilenB = intZeilenB + 1
            
            Case Worksheets(intTabellen).Name Like "AcRep*"
            
                tblInhalt.Cells(intZeilenC, 3).Value = Worksheets(intTabellen).Name
    
                tblInhalt.Cells(intZeilenC, 3).Hyperlinks.Add _
                Anchor:=tblInhalt.Cells(intZeilenC, 1), Address:="", SubAddress:= _
                "'" & Worksheets(intTabellen).Name & "'!A1", _
                ScreenTip:="Klicken Sie um zur Tabelle zu gelangen", _
                TextToDisplay:=Worksheets(intTabellen).Name
                
                intZeilenC = intZeilenC + 1
        
        End Select
        
    Next intTabellen
    
    Application.ScreenUpdating = True
    
End Sub
Lg
Michael


  

Betrifft: AW: Inhaltsverzeichnis Tabellenblätter automatisc von: Chris
Geschrieben am: 10.11.2014 19:15:22

Vielen Dank.
Denk bitte daran, daß das Sheet "Übersicht", in dem das Inhaltsverzeichnis ist, fest bleibt und nicht verändert wird - also auch nicht gelöscht wird wie im Code oben, weil in den ersten 4 Zeilen ein fester Text steht, der nicht verändert wird.
D.h. das Sheet "Übersicht" wird nach Öffnen der Datei automatisch angewählt. Und bei allen neu erzeugten Sheets gibt es einen Zurück-Button zur Übersicht. Von dort aus werden dann wieder über Schaltflächen neue Sheets erstellt und kopiert. Der VBA-Code kommt dann in das Worksheet_Activate Ereignis rein und wird jedesmal beim Aufrufen des Sheets durchlaufen.
Grüße Chris


  

Betrifft: AW: Inhaltsverzeichnis Tabellenblätter automatisc von: Michael
Geschrieben am: 11.11.2014 10:53:09

Nochmals Hallo Chris!

Du hast ja von den Profis hier schon viele elegante und tolle Lösungen erhalten - ich zähle mich bei Weitem nicht zu jenen Profis, möchte Dir meine Lösung aber dennoch anbieten, da ich selbst dabei viel gelernt habe. Vielleicht gefällt Dir dieser Ansatz ja auch:

Sub ÜbersichtUmgekehrtChron()

    Dim intTabellen As Integer
    Dim intZeilenA As Integer
    Dim intZeilenB As Integer
    Dim intZeilenC As Integer
    Dim EndA As Integer
    Dim EndB As Integer
    Dim EndC As Integer
    
    Application.ScreenUpdating = False
    
    intZeilenA = 5
    intZeilenB = 5
    intZeilenC = 5
    
    For intTabellen = 2 To ActiveWorkbook.Worksheets.Count
        
        Select Case True
        
            Case Worksheets(intTabellen).Name Like "Agenda_*"

                Worksheets("Übersicht").Cells(intZeilenA, 1).Hyperlinks.Add _
                Anchor:=Worksheets("Übersicht").Cells(intZeilenA, 1), Address:="", SubAddress:=  _
_
                "'" & Worksheets(intTabellen).Name & "'!A1", _
                ScreenTip:="Klicken Sie um zur Tabelle zu gelangen", _
                TextToDisplay:=Worksheets(intTabellen).Name

                Worksheets("Übersicht").Cells(intZeilenA, 1).Value = Right(Worksheets( _
intTabellen).Name, 10)

                intZeilenA = intZeilenA + 1

            Case Worksheets(intTabellen).Name Like "MoM*"

                Worksheets("Übersicht").Cells(intZeilenB, 2).Hyperlinks.Add _
                Anchor:=Worksheets("Übersicht").Cells(intZeilenB, 2), Address:="", SubAddress:=  _
_
                "'" & Worksheets(intTabellen).Name & "'!A1", _
                ScreenTip:="Klicken Sie um zur Tabelle zu gelangen", _
                TextToDisplay:=Worksheets(intTabellen).Name
                
                Worksheets("Übersicht").Cells(intZeilenB, 2).Value = Right(Worksheets( _
intTabellen).Name, 10)
                
                intZeilenB = intZeilenB + 1
            
            Case Worksheets(intTabellen).Name Like "AcRep*"

                Worksheets("Übersicht").Cells(intZeilenC, 3).Hyperlinks.Add _
                Anchor:=Worksheets("Übersicht").Cells(intZeilenC, 3), Address:="", SubAddress:=  _
_
                "'" & Worksheets(intTabellen).Name & "'!A1", _
                ScreenTip:="Klicken Sie um zur Tabelle zu gelangen", _
                TextToDisplay:=Worksheets(intTabellen).Name
                
                Worksheets("Übersicht").Cells(intZeilenC, 3).Value = Right(Worksheets( _
intTabellen).Name, 10)
                
                intZeilenC = intZeilenC + 1
        
        End Select
        
    Next intTabellen
    
    EndA = Worksheets("Übersicht").Cells(5, 1).End(xlDown).Row
    EndB = Worksheets("Übersicht").Cells(5, 2).End(xlDown).Row
    EndC = Worksheets("Übersicht").Cells(5, 3).End(xlDown).Row
    
    ActiveWorkbook.Worksheets("Übersicht").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Übersicht").Sort.SortFields.Add Key:=Range("A5"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Übersicht").Sort
        .SetRange Range(Cells(5, 1), Cells(EndA, 1))
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    ActiveWorkbook.Worksheets("Übersicht").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Übersicht").Sort.SortFields.Add Key:=Range("B5"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Übersicht").Sort
        .SetRange Range(Cells(5, 2), Cells(EndB, 2))
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    ActiveWorkbook.Worksheets("Übersicht").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Übersicht").Sort.SortFields.Add Key:=Range("C5"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Übersicht").Sort
        .SetRange Range(Cells(5, 3), Cells(EndC, 3))
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
          
    For intZeilenA = 5 To EndA
        Worksheets("Übersicht").Cells(intZeilenA, 1).Value = "Agenda " & Worksheets("Übersicht") _
.Cells(intZeilenA, 1).Value
    Next intZeilenA
    
    For intZeilenB = 5 To EndB
        Worksheets("Übersicht").Cells(intZeilenB, 2).Value = "MoM " & Worksheets("Übersicht"). _
Cells(intZeilenB, 2).Value
    Next intZeilenB
    
    For intZeilenC = 5 To EndC
        Worksheets("Übersicht").Cells(intZeilenC, 3).Value = "AcRep " & Worksheets("Übersicht"). _
Cells(intZeilenC, 3).Value
    Next intZeilenC
    
    Application.ScreenUpdating = True
    
End Sub

Beste Grüße
Michael


  

Betrifft: AW: Inhaltsverzeichnis Tabellenblätter automatisc von: Chris
Geschrieben am: 11.11.2014 11:20:05

Danke Michal,
ich werde mich mal reindenken, langsam verstehe ich die ein oder anderen Befehle und Abläufe.
Anweisungen kriege ich mittlerweile relativ gut hin, Problematisch sind Zuordnungen und Abfragen/Schleifen.
Naja, ihr unterstützt mich ja darin sehr gut.
Vielen Dank nochmals.
Gruß Chris


  

Betrifft: Komplett dynamisch ohne VBA von: {Boris}
Geschrieben am: 10.11.2014 22:31:06

Hi Chris,

das kann man auch dynamisch per Formel und mittels der alten Excel4-Makrofunktion ARBEITSMAPPE.ZUORDNEN() lösen.

Definiere den Namen x mit Bezug auf:

=ARBEITSMAPPE.ZUORDNEN(1+0*JETZT())

Und wenn die Bezeichnungen "Agenda", "MoM" und "AcRep" in den Zellen A4:C4 stehen, dann in A5 folgende Arrayformel:

{=WENN(ZEILEN($1:1)>ANZAHL(SUCHEN(A$4;x));"";HYPERLINK("#'"&INDEX(x; KKLEINSTE(WENN(ISTZAHL(SUCHEN(A$4;x));MTRANS(ZEILE(INDIREKT("1:"&ANZAHL2(x)))));ZEILEN($1:1))) &"'!A1";TEIL(INDEX(x;KKLEINSTE(WENN(ISTZAHL(SUCHEN(A$4;x));MTRANS(ZEILE(INDIREKT("1:"&ANZAHL2(x))))); ZEILEN($1:1)));FINDEN("]";INDEX(x;KKLEINSTE(WENN(ISTZAHL(SUCHEN(A$4;x)); MTRANS(ZEILE(INDIREKT("1:"&ANZAHL2(x)))));ZEILEN($1:1))))+1;99))) }

Diese dann runter und auch nach rechts kopieren.

Hab Dir die Beispielmappe mal angehängt.
Sobald Du Blattnamen änderst oder Blätter hinzufügst oder löschst, werden die Blattauflistungen aktualisiert (auch wenn sie nicht nach Links = blau und unterstrichen - aussehen - es sind Links!).

https://www.herber.de/bbs/user/93663.xlsm

VG, Boris


  

Betrifft: AW: Komplett dynamisch ohne VBA von: Chris
Geschrieben am: 10.11.2014 22:54:06

Interessante Alternative, ich hatte so was ähnliches schon bei meiner Recherche gefunden, daber daß man damit auch dynamisch ist, wußte ich nicht.
Ich werds morgen mal testen.
Gruß Chris


 

Beiträge aus den Excel-Beispielen zum Thema "Inhaltsverzeichnis Tabellenblätter automatisc"