Thema Datum  Von Nutzer Rating
Antwort
21.08.2023 00:07:45 Siegfrid
NotSolved
21.08.2023 01:11:19 Siegfrid
NotSolved
21.08.2023 06:59:26 ralf_b
NotSolved
21.08.2023 07:21:31 Siegfrid
NotSolved
21.08.2023 07:30:38 Siegfrid
NotSolved
21.08.2023 17:14:35 ralf_b
NotSolved
21.08.2023 17:48:54 Siegfrid
NotSolved
21.08.2023 17:48:16 xlKing
NotSolved
21.08.2023 18:23:57 Gast39591
NotSolved
21.08.2023 18:35:44 xlKing
NotSolved
21.08.2023 19:33:18 Siegfrid
*****
NotSolved
21.08.2023 21:11:38 xlKing
NotSolved
22.08.2023 20:18:52 Siegfrid
NotSolved
Blau Hyperlink
22.08.2023 23:47:46 xlKing
NotSolved
22.08.2023 23:57:12 xlKing
NotSolved
25.08.2023 15:16:49 Siegfrid
NotSolved
25.08.2023 15:26:39 Siegfrid
NotSolved
21.08.2023 18:34:31 Siegfrid
NotSolved

Ansicht des Beitrags:
Von:
xlKing
Datum:
22.08.2023 23:47:46
Views:
216
Rating: Antwort:
  Ja
Thema:
Hyperlink

Hey Sigi,

jetzt hab ichs verstanden. Manchmal sagt ein Bild doch mehr als Tausend Worte. Hier gibt es zwei Möglichkeiten. Entweder du suchst mit Range.Find im zweiten Blatt nach dem Eingabewort aus Blatt 1 und kopierst einfach den funktionierenden Link von dort, oder du holst dir die Zeile mit Application.Match und kreierst den Link neu. Letzteres halte ich für besser, da es sich ja immer um die selben Spalten handelt.

Füge in das Modul von Blatt 1 folgenden Code ein:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$B$2" Then
    Zeile = Application.Match(Target.Value, Sheets("Blatt 2").Range("C:C"), 0)
    If Not IsError(Zeile) Then
      Range("A5").Hyperlinks.Add Range("A5"), "", "'Blatt 2'!B" & Zeile & ":L" & Zeile, , Target.Value
    Else
      Range("A5").Hyperlinks.Delete
    End If
  End If
End Sub

Wenn du nun ein Wort eingibst wird der Link entsprechend überschrieben. Wenn das Wort nicht exisitiert wird der Link gelöscht.

Noch ein Tipp für das Modul "Blatt 2". Füge dort diesen Code ein und der Link wird direkt nach deiner Eingabe eines neuen Wertes in Spalte C erstellt, sodass du das nicht selbst übernehmen musst.

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("C:C")) Is Nothing Then
    If Target.Cells(1).Value <> "" Then
      Target.Cells(1).Hyperlinks.Add Target, "", "'Blatt 2'!B" & Target.Row & ":L" & Target.Row, , Target.Value
    Else
      Target.Cells(1).Hyperlinks.Delete
    End If
  End If
End Sub

Gruß Mr. K.


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
21.08.2023 00:07:45 Siegfrid
NotSolved
21.08.2023 01:11:19 Siegfrid
NotSolved
21.08.2023 06:59:26 ralf_b
NotSolved
21.08.2023 07:21:31 Siegfrid
NotSolved
21.08.2023 07:30:38 Siegfrid
NotSolved
21.08.2023 17:14:35 ralf_b
NotSolved
21.08.2023 17:48:54 Siegfrid
NotSolved
21.08.2023 17:48:16 xlKing
NotSolved
21.08.2023 18:23:57 Gast39591
NotSolved
21.08.2023 18:35:44 xlKing
NotSolved
21.08.2023 19:33:18 Siegfrid
*****
NotSolved
21.08.2023 21:11:38 xlKing
NotSolved
22.08.2023 20:18:52 Siegfrid
NotSolved
Blau Hyperlink
22.08.2023 23:47:46 xlKing
NotSolved
22.08.2023 23:57:12 xlKing
NotSolved
25.08.2023 15:16:49 Siegfrid
NotSolved
25.08.2023 15:26:39 Siegfrid
NotSolved
21.08.2023 18:34:31 Siegfrid
NotSolved