Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema CommandButton
BildScreenshot zu CommandButton CommandButton-Seite mit Beispielarbeitsmappe aufrufen

VBA Lösung für Tabellenblattwechsel gesucht

Betrifft: VBA Lösung für Tabellenblattwechsel gesucht von: Nila
Geschrieben am: 14.08.2008 10:07:25

Hallo.

Ich habe folgendes vor:
Ich lege derzeit eine Exceldatei mit Steckbriefen von ca. 150 Personen an.
Jeder Steckbrief steht dabei auf einem eigenen Tabellenblatt.
Die Tabellenblätter werden nach der entsprechenden Person benannt.
Zum Beispiel: Name von Tabellenblatt 70: "Maier, A."
Auf Blatt 2, welches "Suchmaske" heißen soll habe ich in Zelle D9 eine Gültigkeitsliste mit den
Namen und mit Dropdown hinterlegt, über welche die jeweilige person ausgwählt werden kann.
So kann zum Beispiel "Maier, A." ausgewählt werden.
Über einen Commandbutton soll nun das Tabellenblatt "Maier, A." angesteuert werden.

Bisherige Lösung:


Sub Suche()

    Sheets("Suchmaske").Select
    If Range("D9") = "Maier, A." Then
    Sheets("Maier, A.").Select
    End If
    If Range("D9") = "..." Then
    Sheets("...").Select
    End If
    
End Sub



So müsste ich dies aber für jede Person einzeln schreiben.
Gibt es hierfür eine bessere Lösung?

  

Betrifft: AW: VBA Lösung für Tabellenblattwechsel gesucht von: Rudi Maintaire
Geschrieben am: 14.08.2008 10:15:14

Hallo,
ganz einfach
sheets(Range("D9")).select

Gruß
Rudi


  

Betrifft: AW: VBA Lösung für Tabellenblattwechsel gesucht von: AndrRo
Geschrieben am: 14.08.2008 10:15:46


Hallo Nila,

versuch mal die kurzversion

Sub suchen
on error goto Fehler
sheets([D9]).select
exit sub
Fehler:
MSGBOX("Blatt existiert nicht")
End Sub



gruss

AndrRo


  

Betrifft: AW: VBA Lösung für Tabellenblattwechsel gesucht von: Nila
Geschrieben am: 14.08.2008 11:24:43

Hallo.
Erstmal Vielen Dank für die schnellen Antworten.
@ AndrRo:
Bei dieser Lösung bekomme ich als Ergebnis immer
MSGBOX("Blatt existiert nicht")

@ Rudi:
Bei dieser Lösung kommt immer die Fehlermeldung:
"Typen unverträglich"

Sub Suche()
Sheets(Range("D9")).Select
End Sub



Grüße


  

Betrifft: AW: VBA Lösung für Tabellenblattwechsel gesucht von: AndrRo
Geschrieben am: 14.08.2008 11:42:57

Hallo Nila

So funktioniert es:


Sub suchen()
 On Error GoTo Fehler
 Suchname = [d2]
 Sheets(Suchname).Select
 Exit Sub
Fehler:
 MsgBox ("Blatt existiert nicht")
 End Sub




gruss

Andreas


  

Betrifft: AW: VBA Lösung für Tabellenblattwechsel gesucht von: Ramses
Geschrieben am: 14.08.2008 11:47:23

Hallo

Es geht auch ohne Variable

Private Sub CommandButton1_Click()
 On Error GoTo Fehler
 Sheets([D2].Text).Select
 Exit Sub
Fehler:
 MsgBox ("Blatt existiert nicht")
 End Sub



Gruss Rainer


  

Betrifft: AW: VBA Lösung für Tabellenblattwechsel gesucht von: Nila
Geschrieben am: 14.08.2008 11:47:30

Funktioniert super.
Genau das was ich gesucht habe.

Vielen Dank.
Grüße


  

Betrifft: AW: VBA Lösung für Tabellenblattwechsel gesucht von: Ramses
Geschrieben am: 14.08.2008 11:43:53

Hallo

WAS steht denn in D9 wirklich ? !!!
Stimmen die Bezeichnungen 100% überein ?
Wenn im Tabellenamen ein Leerzeichen zuviel drin ist, dann kracht es schon.
Mach doch gleich ein Inhaltsverzeichnis mit Hyperlinks das ist übersichtlicher und verhindert Fehler im schreiben

Sub Create_Hyperlink_Table_of_Contents()
    '(C) Ramses
    'Erstellt ein Inhaltsverzeichnis auf alle Tabellen einer
    'Mappe mit Hyperlinks auf die jeweiligen Tabellen
    Dim tarWks As Worksheet
    Dim i As Integer, myRow As Integer, tmpCnt As Integer
    'Blattnamen anpassen
    Set tarWks = Worksheets("Inhalt")
    'Bestehenden Inhalt löschen
    tarWks.Columns(1).ClearContents
    tarWks.Cells(1, 1) = "Inhalt"
    'Erstellen des Inhaltsverzeichnisses
    '**************************
    'Vertikal
    For i = 2 To Worksheets.count
        tarWks.Cells(i, 1) = Worksheets(i).name
        Cells(i, 1).Hyperlinks.Add Anchor:=Cells(i, 1), Address:="", SubAddress:="'" & Worksheets(i).name & "'!A1", TextToDisplay:=Worksheets(i).name
    Next i
    'Sortiert das Inhaltsverzeichnis
    tarWks.Columns(1).Sort Key1:=tarWks.Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
    '**************************
    'Horizontal
    'tmpCnt = 1
    'myRow = 1
    'For i = 1 To Worksheets.Count
    ' If i Mod 256 = 0 Then
    ' tmpCnt = 1
    ' myRow = myRow + 1
    ' End If
    ' If Worksheets(i).Name <> tarwks.Name Then
    ' tarwks.Cells(myRow, tmpCnt) = Worksheets(i).Name
    ' Cells(myRow, tmpCnt).Hyperlinks.Add Anchor:=Cells(myRow, tmpCnt), Address:="", SubAddress:="'" & Worksheets(i).Name & "'!A1", TextToDisplay:=Worksheets(i).Name
    ' tmpCnt = tmpCnt + 1
    ' End If
    'Next i
End Sub



Gruss Rainer