Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Hyperlink auf Tabellenblatt
#1
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: 4)
Antwortento top
#2
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.
Antwortento top
#3
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
Antwortento top
#4
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
Antwortento top
#5
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
Antwortento top
#6
Problemstellung ebenfalls gepostet hier: https://www.ms-office-forum.net/forum/showthread.php?p=1977303&posted=1#post1977303
Antwortento top
#7
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
Antwortento top
#8
Photo 
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)
   
Antwortento top
#9
Hallo Pean,

kann ich in Deiner Beispieldatei nicht nachvollziehen.  Huh


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

Gruß Uwe
[-] Folgende(r) 1 Benutzer sagt Danke an Kuwer für diesen Beitrag:
  • Pean
Antwortento top
#10
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
Antwortento top


Gehe zu:


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