Hyperlink mit variablem Anzeigenamen?

Forumthread: Hyperlink mit variablem Anzeigenamen?

27.09.2024 14:58:06

HJS

Hallo Freunde,

ich brauche mal (wieder) Eure Hilfe.

Ich habe hier ein geniales Stück VBA Code gefunden um eine Arbeitsmappe zu durchsuchen & das Ergebnise anzeigen zu lassen
(https://www.herber.de/forum/archiv/624to628/627758_Arbeitsmappe_durchsuchen_Ergebnise_anzeigen.html - Big Thx an GraFri)

Als Resultat bekommt man die Tabellenbattbezeichnung sowie die Zelle ausgeworfen in der sich der Suchbegriff befindet:
Mein Suchbegriff ist TEST. Diser befindet sich in:
A1= Tabelle1 ; B1 = A55.
Was ich jetzt noch benötige ist eine Möglichkeit aus dem Resultat eine Verknüpfung zu erstellen von der ich aus das Tabellenblatt mit dem Eintrag anspringen kann. Und der angezeigte Verknüpfungsname sollte dem Inhalt der Zelle A55 (in meinem Beispiel TEST) entsprechen.
Ich komme nicht drauf wie ich mir das zusammenbasteln kann so das Verknüpfungsname variabel funktioniert...

Mein Ansatz ist aktuell folgender:
Ich habe nun in C1 (als Hilfszelle) stehen =("'"&A1&"'"&"!"&B1) dies ergibt 'Tabelle1'!A55. In D1 habe ich die Formel:
=HYPERLINK("#"&C1;('Tabelle1'!A55)). Hier bekomme ich als (Verknüpfungs)Name für den Hyperlink TEST in D1 angezeigt.
Das funktioniert auch gut. ABER ich hätte den Verknüpfungsnamen des Links gerne variabel gestaltet. Kann man den Teil der Formel ('Tabelle1'!A50) so angeben das ich die Daten aus A1 und B1 direkt verwenden kann ohne diese Daten aus den Zellen manuell erfassen zu müssen?
('A1'!B1) funktioniert in dem Zusammenhang ja so leider nicht.

Liebe Grüße HJS

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Hyperlink mit variablem Anzeigenamen?

27.09.2024 16:36:23

Raimund
AW: Hyperlink mit variablem Anzeigenamen?

27.09.2024 21:19:31

HJS
In der Anlage...

27.09.2024 22:30:04

Case
AW: In der Anlage...

27.09.2024 23:22:42

HJS
Meinst du...

28.09.2024 00:55:40

Case
AW: Meinst du...

28.09.2024 11:08:43

HJS

AW: Hyperlink mit variablem Anzeigenamen?

27.09.2024 16:36:23

Raimund

Hi HJS

Mit Hilfe von KI

Option Base 1
Option Compare Text

Sub Suchen_und_anzeigen()
Dim Meldung As Byte, Pos As Byte
Dim Schleife As Byte, y As Byte
Dim Begriff, Suchen() As Variant
Dim Bereich As Range
Dim n%, x%, xZelle%, yZelle%
Dim xTabelle$(), Adresse$(), Text$

' Suchbegriff eingeben
Begriff = InputBox _
("Bitte den zu suchenden Wert eingeben. Sollen 2 Werte" & vbCrLf & _
"gleichzeitig gesucht werden, dann mit Zeichen + " & vbCrLf & _
"voneinander trennen (z.B.: Summe+die)." & vbCrLf & vbCrLf & _
"ENTER ohne Wert = Abbruch", "S U C H M O D U S")
If Begriff = "" Then Exit Sub

Pos = InStr(Begriff, "+")
If Pos Then
ReDim Suchen(2)
Suchen(1) = Left(Begriff, Pos - 1)
Suchen(2) = Right(Begriff, Len(Begriff) - Pos)
Schleife = 2
Else
ReDim Suchen(1)
Suchen(1) = Begriff
Schleife = 1
End If

Application.ScreenUpdating = False

' Eigentlicher Suchvorgang (in allen Tabellenblättern)
x = 1
For y = 1 To Schleife
For n = 1 To Sheets.Count
' Bereich festlegen
Set Bereich = Worksheets(n).UsedRange

With Worksheets(n).Range(Bereich.Address)
xZelle = .Columns(.Columns.Count).Column
yZelle = .Rows(.Rows.Count).Row
Set c = .Find(Suchen(y), after:=Cells(yZelle, xZelle), LookIn:=xlValues)

If Not c Is Nothing Then
ErsteAdresse = c.Address
Do
ReDim Preserve Adresse(x): ReDim Preserve xTabelle(x)
xTabelle(x) = Sheets(n).Name
Adresse(x) = c.Address(RowAbsolute:=False, ColumnAbsolute:=False)
Set c = .FindNext(c)
x = x + 1
Loop While Not c Is Nothing And c.Address > ErsteAdresse
End If
End With
Next n
Next y

Application.ScreenUpdating = True

' Die Anzahl der gefundenen Werte ist (x - 1), wenn keiner gefunden wurde dann ist x = 1
Select Case x
Case 1
Meldung = MsgBox("Es wurde kein übereinstimmender Wert gefunden", _
vbOKOnly, "G E F U N D E N E W E R T E")
Exit Sub
Case Else
Meldung = MsgBox("Es wurden " & (x - 1) & " Übereinstimmungen gefunden.", _
vbOKOnly, "G E F U N D E N E W E R T E")

' Ergebnisse in das Blatt "Suchergebnis" einfügen
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Suchergebnis")

' Vorherige Ergebnisse löschen
ws.Cells.Clear

' Kopfzeilen setzen
ws.[A1] = "Tabelle"
ws.[B1] = "Zelle"

For n = 1 To x - 1
ws.Cells(n + 1, 1) = xTabelle(n)
ws.Cells(n + 1, 2) = Adresse(n)
' Hyperlink erstellen
ws.Hyperlinks.Add Anchor:=ws.Cells(n + 1, 2), _
Address:="", _
SubAddress:=xTabelle(n) & "!" & Adresse(n), _
TextToDisplay:=Adresse(n)
' Formatierung der Zelle ändern
ws.Cells(n + 1, 2).Font.Color = RGB(0, 0, 255) ' Blau
ws.Cells(n + 1, 2).Font.Underline = xlUnderlineStyleSingle ' Unterstrichen
Next n
End Select
End Sub

Gruss

AW: Hyperlink mit variablem Anzeigenamen?

27.09.2024 21:19:31

HJS

Zuersteinmal vielen Dank Raimund für deine Mühe! Auch für die Tatsache das du es in VBA umgesetzt hast!

Leider bekomme ich das nicht zum laufen.

Ich frage mal unverschämt. Kannst du deine Idee vielleicht in den vorhanden VBA Code "einbauen" den ich verwende? Ich bekomme es nicht hin.

Klasse wäre wenn zum aktuellen Ausgabe-Tabellenblatt die Spalte Verknüfung hinzugefügt werden würde und hier der Hyperlink eigetragen wird.

Der VBA Code den ich exakt verwende (eine minimale Variation von GraFri's Original Code) lautet folgendermaßen:

Sub Suchen_und_anzeigen()



Dim Meldung As Byte, Pos As Byte

Dim Schleife As Byte, y As Byte

Dim Begriff, Suchen() As Variant

Dim Bereich As Range

Dim n%, x%, xZelle%, yZelle%

Dim xTabelle$(), Adresse$(), Text$



' Suchbegriff eingeben

Begriff = InputBox _

("Bitte den zu suchenden Film eingeben." & vbCrLf & "Sollen 2 Werte gleichzeitig gesucht werden," & vbCrLf & "dann mit Zeichen '+' voneinander trennen.", "Suchen und ausgeben")

If Begriff = "" Then Exit Sub

Pos = InStr(Begriff, "+")

If Pos Then

    ReDim Suchen(2)

    Suchen(1) = Left(Begriff, Pos - 1)

    Suchen(2) = Right(Begriff, Len(Begriff) - Pos)

    Schleife = 2

Else

    ReDim Suchen(1)

    Suchen(1) = Begriff

    Schleife = 1

End If

Application.ScreenUpdating = False

' Eigentlicher Suchvorgang (in allen Tabellenblättern)

x = 1

For y = 1 To Schleife

  For n = 1 To Sheets.Count

  ' Letzte Zelle des Bereiches ermitteln. Diese Zelle wird als Startzelle für

  ' die Suche definiert, da Suche nach dieser Zelle, also in erster Zelle

  ' des Bereiches beginnt.

  'Bereich festlegen

  Set Bereich = Worksheets(n).UsedRange

  

  With Worksheets(n).Range(Bereich.Address)

      xZelle = .Columns(.Columns.Count).Column

      yZelle = .Rows(.Rows.Count).Row

  End With

  With Sheets(n).Range(Bereich.Address)

      Set c = .Find(Suchen(y), after:=Cells(yZelle, xZelle), LookIn:=xlValues)

      If Not c Is Nothing Then

          ErsteAdresse = c.Address

          Do

              ReDim Preserve Adresse(x): ReDim Preserve xTabelle(x)

              xTabelle(x) = Sheets(n).Name

              Adresse(x) = c.Address(RowAbsolute:=False, ColumnAbsolute:=False)

              Set c = .FindNext(c)

              x = x + 1

          Loop While Not c Is Nothing And c.Address > ErsteAdresse

      End If

  End With

  Next n

Next y

Application.ScreenUpdating = True

' Die Anzahl der gefundenen Werte ist (x - 1), wenn keiner

' gefunden wurde dann ist x = 1

Select Case x

Case 1

    Meldung = MsgBox("Es wurde kein übereinstimmender Wert gefunden", _

    vbOKOnly, "Gefundene Werte")

    Exit Sub

Case Else

    Meldung = MsgBox("Es wurden " & (x - 1) & " Übereinstimmungen gefunden.", _

    vbOKOnly, "Gefundene Werte")

'Tabelle einfügen

Worksheets.Add.Move after:=Worksheets(Worksheets.Count)

On Error Resume Next

With ActiveSheet

    .Name = Begriff

    .[A1] = "Festplatte"

    .[A1].HorizontalAlignment = xlCenter

    .[B1] = "Zelle"

    .[B1].HorizontalAlignment = xlCenter

    For n = 1 To x - 1

        .Cells(n + 1, 1) = xTabelle(n)

        .Cells(n + 1, 1).HorizontalAlignment = xlCenter

        .Cells(n + 1, 2) = Adresse(n)

        .Cells(n + 1, 2).HorizontalAlignment = xlCenter

    Next n

End With

End Select

End Sub

Wenn zu schwierig bin ich auch über einen manuellen Ansatz zu meiner ursprünglichen Fragestellung dankbar

In der Anlage...

27.09.2024 22:30:04

Case

Moin, :-)

... ist es mit VBA und Formel gelöst: ;-)
https://www.herber.de/bbs/user/172461.xlsb

In Tabelle2 sind die Formeln. In E und F ist der Unterschied, dass entweder nur die Fundzelle markiert wird, oder bis Spalte E. Zwecks Übersicht.
In H und I kann man die Formel (durch INDIREKT) runterziehen.

Die Formel wird auch per VBA eingetragen. Kannst du ja rauslöschen, wenn du es nicht willst. ;-)

Servus
Case

AW: In der Anlage...

27.09.2024 23:22:42

HJS

Das ist richtig cool!!! Vielen Dank Case!!!

Ich traue mich ja fast nicht noch was anzumerken bzw. zu fragen aber ein Haar ist noch in der Suppe...

Wenn man mit dem VBA Code sucht, um bei unserem Beispiel zu bleiben TEST, findet er ja alle Einträge die TEST beinhalten und gibt diese auch aus. Beispiel TEST 1 oder TEST Zulu.
Dies ist auch so erwünscht. Nur ist der Name des angezeigten Hyperlinks aktuell leider immer "nur" TEST und nicht der vollständige Name aus der (Quell)Zelle (z.B. TEST 1). Ich hätte gerne das der Hyperlink auch den Namen der kompletten (Quell)Zelle zeigt. Also nicht nur TEST sondern TEST 1 (oder TEST Zulu)
Dahingehend noch eine Idee?

LG HJS

Meinst du...

28.09.2024 00:55:40

Case

Moin, :-)

... so? ;-)
https://www.herber.de/bbs/user/172464.xlsb

Servus
Case

AW: Meinst du...

28.09.2024 11:08:43

HJS

Moin Case,
jetzt ist es genauso wie ich es mir vorgestellt habe! Ganz großes Kino! Vielen Dank nochmals!
Ein Platz in meinen Abendgebeten ist dir sicher :-)

Kleine Anmerkung: Die "manuelle" Formel funktioniert nicht. Aber diese verwende ich dank deiner luxuriösen (VBA) Lösung nicht.
Das nur der Vollständigkeit Halber.

(Ganz) Liebe Grüße HJS

Beliebteste Forumthreads (12 Monate)

Hyperlink mit variablem Anzeigenamen?

Forumthread: Hyperlink mit variablem Anzeigenamen?

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread