Clever-Excel-Forum › Office-Anwendungen › Excel v
Hyperlink auf Tabellenblatt

Thema geschlossen 
Baumstrukturmodus
Hyperlink auf Tabellenblatt
Pean Offline
pausiert
Registriert seit: 02.12.2016
Version(en): Office 2010
#1
09.04.2020, 23:40
Hallo Zusammen,

Mühsam ernährt sich das Eichhörnchen. Nachdem ich schon einigen Support hier im Forum erhalten habe, stehe ich mal wieder wie der Esel am Berg.
Mr. Google zeigte mir viele Beispiele, aber keines, welches ich erfolgreich adaptieren konnte.

Aus einer Liste erstelle ich automatisch Tabellenblätter, was Dank Hilfe von "Frogger1986" auch wunderbar klappt.
Zusätzlich wird der Tabellenblattnamen in einer Liste nachgeführt, was auch funktioniert, wenn auch eher schlecht umgesetzt von mir, siehe unten in grün.
Leider kriege ich es aber nicht hin, in dieser Liste den Hyperlink auf das Tabellenblatt zu legen.

Irgend jemand eine Idee wie der korrekte Syntax ist für die beiden Zeilen unten in rot?
Zum Testen das xls im Anhang.

Bin für jeden Tipp dankbar.
Grüsse Pean


Sub Kundenliste()
'
Dim i As Integer
    Dim Last As Long
    Dim sheet As Worksheet
     
    Last = ThisWorkbook.Sheets("Liste").Cells(Rows.Count, 1).End(xlUp).Row 'Letzte benutzte Zeile im Bereich
   
    On Error GoTo ErrExit
   
    GetMoreSpeed
   
    For i = 4 To Last
        If ThisWorkbook.Sheets("Liste").Cells(i, 2).Value = Worksheets("Liste").Cells(1, 2).Value And (ThisWorkbook.Sheets("Liste").Cells(i, 3).Value > 0 Or ThisWorkbook.Sheets("Liste").Cells(i, 4).Value > 0) Then
                    SH = False
            For Each sheet In ThisWorkbook.Sheets
                If sheet.Name = ThisWorkbook.Sheets("Liste").Cells(i, 1).Value Then
                    SH = True
                    Exit For
                End If
            Next
            If SH = False Then
            ThisWorkbook.Sheets("Muster").Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
                      With ThisWorkbook.Worksheets(Sheets.Count)
                    .Name = ThisWorkbook.Sheets("Liste").Cells(i, 1).Value
                    .Cells(2, 1) = ThisWorkbook.Sheets("Liste").Cells(i, 1).Value
                    .Cells(1, 2).Value = ThisWorkbook.Sheets("Liste").Cells(i, 2).Value
              End With
              Sheets("Kundenliste").Select
              Range("A8").Select
              Selection.End(xlDown).Select
              ActiveCell.Cells(2, 1).Select
              ActiveCell.Value = ThisWorkbook.Sheets("Liste").Cells(i, 1).Value
            '  ActiveCell.Value = Kundennummer'
            '  ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'" & Kundennummer & "'!A1", TextToDisplay:=Kundennummer '
              End If
        End If
    Next
   
ErrExit:
    GetMoreSpeed 0
End Sub

Sub GetMoreSpeed(Optional ByVal Modus As Integer = 1)
    Static lngCalc As Long
   
    With Application
        If Modus = 1 Then
            lngCalc = .Calculation
            .ScreenUpdating = False
            .EnableEvents = False
            .DisplayAlerts = False
            .Calculation = -4135
'            .Cursor = xlWait
        Else
            .ScreenUpdating = True
            .EnableEvents = True
            .DisplayAlerts = True
            .Calculation = IIf(lngCalc <> 0, lngCalc, -4105)
'            .Cursor = xlDefault
        End If
    End With


End Sub


Angehängte Dateien
.xlsm   Kunden_V4.xlsm (Größe: 34,15 KB / Downloads: 5)
Suchen
Top
Raoul21 Offline
pausiert
Registriert seit: 01.04.2020
Version(en): 2007
#2
10.04.2020, 00:14
Grün:
Sheets("Kundenliste").Range("A8").End(xlDown).Cells(2, 1) = ThisWorkbook.Sheets("Liste").Cells(i, 1).Value

SH und Kundennummer sind nicht deklariert.
Was ist Kundennummer? Sollte man festlegen.
Suchen
Top
Pean Offline
pausiert
ThreadStarter
Registriert seit: 02.12.2016
Version(en): Office 2010
#3
10.04.2020, 11:14
Hallo Raoul,

Vielen Dank, damit konnte ich schon den ersten Teil besser umsetzen. Habe nun auch "Kundennummer" noch deklariert, aber das Einfügen des Hyperlink funktioniert trotzdem nicht. Kriege es nicht hin, das der eingefügte Wert auf das Tabellenblatt zeigt.

Noch eine Idee dazu?

Besten Dank
Pean

Sub Kundenliste()
'
Dim i As Integer
    Dim Last As Long
    Dim sheet As Worksheet
    Dim Kundennummer As Integer
    Dim SH As Integer
     
    Last = ThisWorkbook.Sheets("Liste").Cells(Rows.Count, 1).End(xlUp).Row 'Letzte benutzte Zeile im Bereich
   
    On Error GoTo ErrExit
   
    GetMoreSpeed
   
    For i = 4 To Last
        If ThisWorkbook.Sheets("Liste").Cells(i, 2).Value = Worksheets("Liste").Cells(1, 2).Value And (ThisWorkbook.Sheets("Liste").Cells(i, 3).Value > 0 Or ThisWorkbook.Sheets("Liste").Cells(i, 4).Value > 0) Then
                    SH = False
            For Each sheet In ThisWorkbook.Sheets
                If sheet.Name = ThisWorkbook.Sheets("Liste").Cells(i, 1).Value Then
                    SH = True
                  Exit For
              End If
              Next
          If SH = False Then
                      ThisWorkbook.Sheets("Muster").Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
                      With ThisWorkbook.Worksheets(Sheets.Count)
                     .Name = ThisWorkbook.Sheets("Liste").Cells(i, 1).Value
                     .Cells(2, 1) = ThisWorkbook.Sheets("Liste").Cells(i, 1).Value
                     End With
                    Sheets("Kundenliste").Range("A8").End(xlDown).Cells(2, 1) = ThisWorkbook.Sheets("Liste").Cells(i, 1).Value
                    Sheets("Kundenliste").Range("A8").End(xlDown).Cells(1, 1) = Kundennummer
                    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'" & Kundennummer & "'!A1", TextToDisplay:=Kundennummer
              End If
        End If
    Next
Suchen
Top
Kuwer Offline
Excelanwender mit VBA
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
#4
10.04.2020, 12:40
Hallo Pean,

Raoul21 schrieb:
Zitat:Was ist Kundennummer? Sollte man festlegen.

Die fehlende Deklaration sprach er eine Zeile vorher an!

Kundennummer ist und bleibt in Deinem Code weiterhin 0 (Null)!

Gruß Uwe
Suchen
Top
Pean Offline
pausiert
ThreadStarter
Registriert seit: 02.12.2016
Version(en): Office 2010
#5
10.04.2020, 14:34
Halllo Kuwer,

Danke für dein Feedback.

Korrekt, der Wert gibt immer 0, das sehe sehe ich schon auch, wenn ich das Makro step bei step ausführe.
Wieso übernimmt "Kundennummer" nicht den vorher eingefügten Wert der Zelle?
Mit Sheets("Kundenliste").Range("A8").End(xlDown).Cells(1, 1) müsste doch der Wert der letzten Zelle dieser Spalte übernommen werden.

Sheets("Kundenliste").Range("A8").End(xlDown).Cells(1, 1) = Kundennummer

Für einen Profi vermutlich eine blöde Frage, für mich gerade ein Rätsel.

Grüsse
Pean
Suchen
Top
Pean Offline
pausiert
ThreadStarter
Registriert seit: 02.12.2016
Version(en): Office 2010
#6
10.04.2020, 16:42
Problemstellung ebenfalls gepostet hier: https://www.ms-office-forum.net/forum/sh...?p=1977303&posted=1#post1977303
Suchen
Top
Kuwer Offline
Excelanwender mit VBA
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
#7
10.04.2020, 17:56 (Dieser Beitrag wurde zuletzt bearbeitet: 10.04.2020, 17:56 von Kuwer.)
Hallo Pean,

wenn Kundennummer etwas zugewiesen werden soll, müsste es auf der linken Seite der Gleichung stehen. Wink

Hier mal eine Komplettlösung mit Hyperlink hin und wieder zurück:

Code:
Sub Kundenliste_Kuwer()

    Dim i As Long
    Dim Last As Long
    Dim sheet As Worksheet
    Dim Kundennummer As String
    Dim SH As Boolean
   
    Last = ThisWorkbook.Sheets("Liste").Cells(Rows.Count, 1).End(xlUp).Row 'Letzte benutzte Zeile im Bereich
    'GetMoreSpeed
    For i = 4 To Last
      Kundennummer = ThisWorkbook.Sheets("Liste").Cells(i, 1).Value
      If ThisWorkbook.Sheets("Liste").Cells(i, 2).Value = Worksheets("Liste").Cells(1, 2).Value And (ThisWorkbook.Sheets("Liste").Cells(i, 3).Value > 0 Or ThisWorkbook.Sheets("Liste").Cells(i, 4).Value > 0) Then
        SH = False
        For Each sheet In ThisWorkbook.Sheets
          If sheet.Name = Kundennummer Then
            SH = True
            Exit For
          End If
        Next
        If SH = False Then
          ThisWorkbook.Sheets("Muster").Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
          ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Kundennummer
          With ThisWorkbook.Worksheets("Kundenliste").ListObjects("Tabelle2")
            .Parent.Hyperlinks.Add _
              Anchor:=.Range(1, 1).Offset(.ListRows.Count + 1, 0), Address:="", _
              SubAddress:="'" & Kundennummer & "'!A1", _
              TextToDisplay:=Kundennummer
            ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Hyperlinks.Add _
              Anchor:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Cells(2, 1), Address:="", _
              SubAddress:=.Range(1, 1).Offset(.ListRows.Count, 0).Address(External:=True), _
              TextToDisplay:=Kundennummer
          End With
        End If
      End If
    Next
End Sub

Gruß Uwe
Suchen
Top
Pean Offline
pausiert
ThreadStarter
Registriert seit: 02.12.2016
Version(en): Office 2010
#8
Photo  10.04.2020, 18:44 (Dieser Beitrag wurde zuletzt bearbeitet: 10.04.2020, 18:44 von Pean.)
Hallo Kuwer,



Vielen Dank für deine Lösung. Damit bin ich schon mal einen Schritt weiter, bezüglich meines Problemes.

Die Tabellenblätter und der Link zurück werden korrekt erstellt.

Jedoch wird in der "Kundenliste" jeweils nur der erste Eintrag gemacht und der Hyperlink wird durch die Schlaufe überschrieben.

Bild zur "Kundenliste" siehe Beilage

Was muss ich ändern, damit er auf die nächste Zeile springt und die Tabelle fortführt?



btw. auf deine Lösung wäre ich so gar nie gekommen. Verstehe auch nicht alles, selbst wenn es schwarz auf weiss vor mir steht. Hut ab.



Grüsse

Pean


Angehängte Dateien Thumbnail(s)
   
Suchen
Top
Kuwer Offline
Excelanwender mit VBA
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
#9
10.04.2020, 18:54
Hallo Pean,

kann ich in Deiner Beispieldatei nicht nachvollziehen.  Huh


.xlsm   Kunden_V4_Kuwer.xlsm (Größe: 32,75 KB / Downloads: 3)

Gruß Uwe
[-] Folgende(r) 1 Nutzer sagt Danke an Kuwer für diesen Beitrag:
  • Pean
Suchen
Top
Pean Offline
pausiert
ThreadStarter
Registriert seit: 02.12.2016
Version(en): Office 2010
#10
10.04.2020, 19:43
Hallo Kuwer,

Habe das Problem gefunden, es liegt an meiner Excel 2016 Installation. Hier scheint irgend etwas zu klemmen.
Mit anderer Excel Version (2010) oder mit anderem PC und Excel 2016 funktioniert es.

Du hast mir jedenfalls mega geholfen...auf deiner Lösung sollte ich weiter aufbauen können.
Super Sache, vielen Dank.

Grüsse,
Pean
Suchen
Top
Thema geschlossen 


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste