Hyperlink auf anderes Tabellenblatt

381 Aufrufe
Gefragt 1, Sep 2017 in Tabellenkalkulation von Mitglied (259 Punkte)
Hallo,

kann ich dien Inhalt einer Zelle auf einem anderen Tabellenblatt [xurl=http://jamaipa.de|Jamaipa - Suche ohne Spam und Shops]suchen[/url] (Sverweis ?) und dann nach einem klick auf die Zelle (Hyperlink) in die Zelle mit dem gefundenen Inhalt springen?

Bsp.:
In Tabellenblatt Zusammenfassung steht der Wert: 12345

Diesen Wert finde ich in einer Spalte des Tabellenblattes Rohdaten.

Ich möchte mir ggf. die Rohdaten anschauen und möchte nicht suchen, sondern durch einen Klick direkt auf den Datensatz springen...

Danke vorab :)

12 Antworten

0 Punkte
Beantwortet 2, Sep 2017 von coros-o-Cokkie
Hallo happy1998!

Eine Möglichkeit wäre das über einen VBA-Code zu realisieren. Nachfolgender Code muss in das VBA-Projekt des Tabellenblatts „[i]Zusammenfassung[/i]“ kopiert werden. Der Code reagiert auf das Anwählen jeder Zelle. Es wird der Wert aus der angewählten Zelle ausgelesen und dann im Tabellenblatt „[i]Rohdaten[/i]“ in Spalte B nach diesem Wert gesucht. Wurde der Wert gefunden, wir das Blatt „Rohdaten aufgerufen und die Zelle mit dem gefundenen Wert markiert.

Hier nun der VBA-Code:

[code]Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rngSuchbereich          As Range

Dim intArrayIndex           As Integer
Dim intAddress              As Integer
Dim intAbfrage              As Integer

Dim strFindAddressArry()    As String
Dim strFirstFindAddress     As String

'Wenn mehr als eine zelle markiert wurde, dann an dieser Stelle den Code beenden
If Target.CountLarge > 1 Or IsError(Target) Then Exit Sub

'Wenn in der markierten Zelle ein Eintrtag vorhanden ist...
If Target.Cells.Value > "" Then
    
    'Im Blatt "Rohdaten" in SPalte B nach Übereinstimmungen suchen
    Set rngSuchbereich = Sheets("Rohdaten").Columns(2).Find(What:=Target.Cells, _
                            LookIn:=xlFormulas, LookAt:=xlPart, MatchCase:=True)
                                    
    'Wenn in "rngSuchbereich" etwas zurückgegeben wird
    If Not rngSuchbereich Is Nothing Then
        
        'Die gefundene Adresse in Variable "strFirstFindAddress" schreiben, wird benötigt, wenn man mehrere Ergebnisse zu erwarten hat.
        strFirstFindAddress = rngSuchbereich.Address
    
        Do
            'Zähler um die Zahl 1 erhöhen
            intArrayIndex = intArrayIndex + 1
            
            'Die Arrayvariable neu dimensionieren
            ReDim Preserve strFindAddressArry(1 To intArrayIndex)
            
            'Die Zeilennummer in die Arrayvariable schreiben
            strFindAddressArry(intArrayIndex) = rngSuchbereich.Row
    
            'Nach der nächsten Übereinstimmung suchen
            Set rngSuchbereich = Sheets("Rohdaten").Columns(2).FindNext(rngSuchbereich)
        Loop While Not rngSuchbereich Is Nothing And rngSuchbereich.Address <> strFirstFindAddress
    
    End If
    
    If UBound(strFindAddressArry) > 0 Then
        'Blatt "Rohdaten" aufrufen
        Sheets("Rohdaten").Activate
        
        'Schleife um das eventuell gefüllte Array auszuwerten
        For intAddress = 1 To UBound(strFindAddressArry)
        
            'im Tabellenblatt "Rohdaten" die Zeile aus dem Array in Spalte B markieren
            Sheets("Rohdaten").Cells(CInt(strFindAddressArry(intAddress)), 2).Select
            
            'Wenn mehr als ein Eintrag im Array eine Abfrage anzeigen ob die nächste Übereinstimmung aufgerufen werden soll
            If intAddress < UBound(strFindAddressArry) Then _
                intAbfrage = MsgBox("Nächste Übereinstimmung anzeigen?", vbQuestion + vbYesNo, "Frage...")
            
            'Wenn Auswahl "Nein", dann an dieser Stelle den Code beenden
            If intAbfrage = 7 Then Exit Sub
        Next
    End If
    
    'Variable zurücksetzen
    Set rngSuchbereich = Nothing
End If
End Sub[/code]


Wenn Du in einer anderen Spalte als in Spalte B im Blatt „[i]Rohdaten[/i]“ Übereinstimmungen suchen möchtest, dann musst Du die Zahl 2 in den Codezeilen

[code]Set rngSuchbereich = Sheets("Rohdaten").Columns(2).Find(What:=Target.Cells, _
[/code]
[code]Set rngSuchbereich = Sheets("Rohdaten").Columns(2).FindNext(rngSuchbereich)
[/code]
[code]Sheets("Rohdaten").Cells(CInt(strFindAddressArry(intAddress)), 2).Select
[/code]
gegen eine andere tauschen. Hierbei gilt, die Zahl 1 ist Spalte A, die Zahl 2 ist Spalte B, Zahl 3 die Spalte C usw.

Solltest Du nicht wissen, wie Du den Code in Deine Datei bekommst, dann schau mal auf [url=http://www.excelbeispiele.de] [b][u] meiner HP [/u][/b][/url] in der [b] Rubrik Anleitungen [/b]und dort dann in der[b] Anleitungsnummer 2 [/b]nach. Dort stelle ich dazu eine bebilderte Anleitung zur Verfügung, die Dir sicherlich helfen wird.\n\nBei Fragen melde Dich.

MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]
0 Punkte
Beantwortet 2, Sep 2017 von coros-o-Cokkie
Hi,

ich nochmal. Bei obigem Code trat ein Fehler auf, wenn es zu dem Suchbegriff keine Gegenstelle gefunden wurde. Daher hier nochmal den geänderte VBA-Code.

[code]Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rngSuchbereich          As Range

Dim intArrayIndex           As Integer
Dim intAddress              As Integer
Dim intAbfrage              As Integer

Dim strFindAddressArry()    As String
Dim strFirstFindAddress     As String

'Wenn mehr als eine zelle markiert wurde, dann an dieser Stelle den Code beenden
If Target.CountLarge > 1 Or IsError(Target) Then Exit Sub

'Wenn in der markierten Zelle ein Eintrtag vorhanden ist...
If Target.Cells.Value > "" Then
    
    'Im Blatt "Rohdaten" in SPalte B nach Übereinstimmungen suchen
    Set rngSuchbereich = Sheets("Rohdaten").Columns(2).Find(What:=Target.Cells, _
                            LookIn:=xlFormulas, LookAt:=xlPart, MatchCase:=True)
                                    
    'Wenn in "rngSuchbereich" etwas zurückgegeben wird
    If Not rngSuchbereich Is Nothing Then
        
        'Die gefundene Adresse in Variable "strFirstFindAddress" schreiben, wird benötigt, wenn man mehrere Ergebnisse zu erwarten hat.
        strFirstFindAddress = rngSuchbereich.Address
    
        Do
            'Zähler um die Zahl 1 erhöhen
            intArrayIndex = intArrayIndex + 1
            
            'Die Arrayvariable neu dimensionieren
            ReDim Preserve strFindAddressArry(1 To intArrayIndex)
            
            'Die Zeilennummer in die Arrayvariable schreiben
            strFindAddressArry(intArrayIndex) = rngSuchbereich.Row
    
            'Nach der nächsten Übereinstimmung suchen
            Set rngSuchbereich = Sheets("Rohdaten").Columns(2).FindNext(rngSuchbereich)
        Loop While Not rngSuchbereich Is Nothing And rngSuchbereich.Address <> strFirstFindAddress
    
    End If
    
    If intArrayIndex > 0 Then
        'Blatt "Rohdaten" aufrufen
        Sheets("Rohdaten").Activate
        
        'Schleife um das eventuell gefüllte Array auszuwerten
        For intAddress = 1 To UBound(strFindAddressArry)
        
            'im Tabellenblatt "Rohdaten" die Zeile aus dem Array in Spalte B markieren
            Sheets("Rohdaten").Cells(CInt(strFindAddressArry(intAddress)), 2).Select
            
            'Wenn mehr als ein Eintrag im Array eine Abfrage anzeigen ob die nächste Übereinstimmung aufgerufen werden soll
            If intAddress < UBound(strFindAddressArry) Then _
                intAbfrage = MsgBox("Nächste Übereinstimmung anzeigen?", vbQuestion + vbYesNo, "Frage...")
            
            'Wenn Auswahl "Nein", dann an dieser Stelle den Code beenden
            If intAbfrage = 7 Then Exit Sub
        Next
    End If
    
    'Variable zurücksetzen
    Set rngSuchbereich = Nothing
End If
End Sub[/code]

Alles weitere ist wie in meiner 1. Antwort beschrieben.

MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]
0 Punkte
Beantwortet 7, Sep 2017 von Mitglied (259 Punkte)
Hallo coros-o-Cokkie,

sorry für die späte Rückmeldung ):
Das Makro habe ich heute erst ausprobieren können & es funktioniert !

Habe lediglich Spalte B in G (2 in 7) in den Rohdaten anpassen!!

Daanke!!

Hätte aber noch eine Frage / Bitte:

Im Tabellenblatt Zusammenfassung funktioniert das Makro durch Auswahl oder klicken der Zelle in Spalte B und C.
Wie lässt sich denn die Funktion für Zellen in C deaktivieren?

Wäre auch ein Doppelklick notwendig?
0 Punkte
Beantwortet 7, Sep 2017 von coros-o-Cockies
Hallo happy1998!

Dann sieht der Code wie folgt aus:
[code]
Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim rngSuchbereich          As Range

Dim intArrayIndex           As Integer
Dim intAddress              As Integer
Dim intAbfrage              As Integer

Dim strFindAddressArry()    As String
Dim strFirstFindAddress     As String

'Wenn mehr als eine zelle markiert wurde, dann an dieser Stelle den Code beenden
If Target.CountLarge > 1 Or IsError(Target) Then Exit Sub

'Wenn ein Doppelklick in einer anderen Spalte als B getätigt wurde Prozdur beenden
If Target.Column <> 2 Then Exit Sub

'Wenn in der markierten Zelle ein Eintrtag vorhanden ist...
If Target.Cells.Value > "" Then
    
    'Im Blatt "Rohdaten" in SPalte B nach Übereinstimmungen suchen
    Set rngSuchbereich = Sheets("Rohdaten").Columns(7).Find(What:=Target.Cells, _
                            LookIn:=xlFormulas, LookAt:=xlPart, MatchCase:=True)
                                    
    'Wenn in "rngSuchbereich" etwas zurückgegeben wird
    If Not rngSuchbereich Is Nothing Then
        
        'Die gefundene Adresse in Variable "strFirstFindAddress" schreiben, wird benötigt, wenn man mehrere Ergebnisse zu erwarten hat.
        strFirstFindAddress = rngSuchbereich.Address
    
        Do
            'Zähler um die Zahl 1 erhöhen
            intArrayIndex = intArrayIndex + 1
            
            'Die Arrayvariable neu dimensionieren
            ReDim Preserve strFindAddressArry(1 To intArrayIndex)
            
            'Die Zeilennummer in die Arrayvariable schreiben
            strFindAddressArry(intArrayIndex) = rngSuchbereich.Row
    
            'Nach der nächsten Übereinstimmung suchen
            Set rngSuchbereich = Sheets("Rohdaten").Columns(7).FindNext(rngSuchbereich)
        Loop While Not rngSuchbereich Is Nothing And rngSuchbereich.Address <> strFirstFindAddress
    
    End If
    
    If intArrayIndex > 0 Then
        'Blatt "Rohdaten" aufrufen
        Sheets("Rohdaten").Activate
        
        'Schleife um das eventuell gefüllte Array auszuwerten
        For intAddress = 1 To UBound(strFindAddressArry)
        
            'im Tabellenblatt "Rohdaten" die Zeile aus dem Array in Spalte B markieren
            Sheets("Rohdaten").Cells(CInt(strFindAddressArry(intAddress)), 7).Select
            
            'Wenn mehr als ein Eintrag im Array eine Abfrage anzeigen ob die nächste Übereinstimmung aufgerufen werden soll
            If intAddress < UBound(strFindAddressArry) Then _
                intAbfrage = MsgBox("Nächste Übereinstimmung anzeigen?", vbQuestion + vbYesNo, "Frage...")
            
            'Wenn Auswahl "Nein", dann an dieser Stelle den Code beenden
            If intAbfrage = 7 Then Exit Sub
        Next
    End If
    
    'Variable zurücksetzen
    Set rngSuchbereich = Nothing
End If

End SubOption Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim rngSuchbereich          As Range

Dim intArrayIndex           As Integer
Dim intAddress              As Integer
Dim intAbfrage              As Integer

Dim strFindAddressArry()    As String
Dim strFirstFindAddress     As String

'Wenn mehr als eine zelle markiert wurde, dann an dieser Stelle den Code beenden
If Target.CountLarge > 1 Or IsError(Target) Then Exit Sub

'Wenn ein Doppelklick in einer anderen Spalte als B getätigt wurde Prozdur beenden
If Target.Column <> 2 Then Exit Sub

'Wenn in der markierten Zelle ein Eintrtag vorhanden ist...
If Target.Cells.Value > "" Then
    
    'Im Blatt "Rohdaten" in SPalte B nach Übereinstimmungen suchen
    Set rngSuchbereich = Sheets("Rohdaten").Columns(7).Find(What:=Target.Cells, _
                            LookIn:=xlFormulas, LookAt:=xlPart, MatchCase:=True)
                                    
    'Wenn in "rngSuchbereich" etwas zurückgegeben wird
    If Not rngSuchbereich Is Nothing Then
        
        'Die gefundene Adresse in Variable "strFirstFindAddress" schreiben, wird benötigt, wenn man mehrere Ergebnisse zu erwarten hat.
        strFirstFindAddress = rngSuchbereich.Address
    
        Do
            'Zähler um die Zahl 1 erhöhen
            intArrayIndex = intArrayIndex + 1
            
            'Die Arrayvariable neu dimensionieren
            ReDim Preserve strFindAddressArry(1 To intArrayIndex)
            
            'Die Zeilennummer in die Arrayvariable schreiben
            strFindAddressArry(intArrayIndex) = rngSuchbereich.Row
    
            'Nach der nächsten Übereinstimmung suchen
            Set rngSuchbereich = Sheets("Rohdaten").Columns(7).FindNext(rngSuchbereich)
        Loop While Not rngSuchbereich Is Nothing And rngSuchbereich.Address <> strFirstFindAddress
    
    End If
    
    If intArrayIndex > 0 Then
        'Blatt "Rohdaten" aufrufen
        Sheets("Rohdaten").Activate
        
        'Schleife um das eventuell gefüllte Array auszuwerten
        For intAddress = 1 To UBound(strFindAddressArry)
        
            'im Tabellenblatt "Rohdaten" die Zeile aus dem Array in Spalte B markieren
            Sheets("Rohdaten").Cells(CInt(strFindAddressArry(intAddress)), 7).Select
            
            'Wenn mehr als ein Eintrag im Array eine Abfrage anzeigen ob die nächste Übereinstimmung aufgerufen werden soll
            If intAddress < UBound(strFindAddressArry) Then _
                intAbfrage = MsgBox("Nächste Übereinstimmung anzeigen?", vbQuestion + vbYesNo, "Frage...")
            
            'Wenn Auswahl "Nein", dann an dieser Stelle den Code beenden
            If intAbfrage = 7 Then Exit Sub
        Next
    End If
    
    'Variable zurücksetzen
    Set rngSuchbereich = Nothing
End If

End Sub[/code]

Du musst Deinen alten VBA-Code löschen und dann obigen Code einfügen.

Übrigens, auch wenn Du nur unter Deinem Nicknamen hier postest, kannst Du mich ruhig mit meinem Realnamen ansprechen. Der steht immer am Ende eines Posts.

MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]
0 Punkte
Beantwortet 11, Sep 2017 von Mitglied (259 Punkte)
Hi Oliver,

danke für Deine Mühe.

Bei Anwendung des Makros kommt folgende Fehlermeldung: "Mehrdeutiger Name: Worksheet_BeforeDoubleClick"
... und zwar egal auf welche Spalte ich doppelt klicke - in B steht mein Wert.

Eigentlich sollte ein Doppelklick auf andere Spalten unwirksam sein...

VG
Matthias
0 Punkte
Beantwortet 11, Sep 2017 von coros-o-Cockies
Hallo Matthias!

Wohin hast Du den Code kopiert?

MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]
0 Punkte
Beantwortet 11, Sep 2017 von Mitglied (259 Punkte)
Hallo

der Code steht in der Tabelle Zusammenfassung; also wie bisher in der Tabelle aus der heraus der Doppelklick erfolget.
0 Punkte
Beantwortet 11, Sep 2017 von Mitglied (259 Punkte)
Hallo Oliver,

liegt es vlt. daran, dass ich nur die Hälfte des Codes eingeben soll?

Z.B.
Private Sub Worksheet_BeforeDoubleClick(...
bis
End Sub

und die erste Hälfte weglassen soll?
ab
Option Explicit

bis
End SubOption Explicit

??
0 Punkte
Beantwortet 11, Sep 2017 von coros-o-Cockies
Hallo Matthias!

Ja, sorry, da habe ich auf versehen 2x den Code kopiert. Du musst den unteren Teil ab "[i]End Sub[/i]" weglassen. Also nur:
[code]
Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim rngSuchbereich          As Range

Dim intArrayIndex           As Integer
Dim intAddress              As Integer
Dim intAbfrage              As Integer

Dim strFindAddressArry()    As String
Dim strFirstFindAddress     As String

'Wenn mehr als eine zelle markiert wurde, dann an dieser Stelle den Code beenden
If Target.CountLarge > 1 Or IsError(Target) Then Exit Sub

'Wenn ein Doppelklick in einer anderen Spalte als B getätigt wurde Prozdur beenden
If Target.Column <> 2 Then Exit Sub

'Wenn in der markierten Zelle ein Eintrtag vorhanden ist...
If Target.Cells.Value > "" Then
    
    'Im Blatt "Rohdaten" in SPalte B nach Übereinstimmungen suchen
    Set rngSuchbereich = Sheets("Rohdaten").Columns(7).Find(What:=Target.Cells, _
                            LookIn:=xlFormulas, LookAt:=xlPart, MatchCase:=True)
                                    
    'Wenn in "rngSuchbereich" etwas zurückgegeben wird
    If Not rngSuchbereich Is Nothing Then
        
        'Die gefundene Adresse in Variable "strFirstFindAddress" schreiben, wird benötigt, wenn man mehrere Ergebnisse zu erwarten hat.
        strFirstFindAddress = rngSuchbereich.Address
    
        Do
            'Zähler um die Zahl 1 erhöhen
            intArrayIndex = intArrayIndex + 1
            
            'Die Arrayvariable neu dimensionieren
            ReDim Preserve strFindAddressArry(1 To intArrayIndex)
            
            'Die Zeilennummer in die Arrayvariable schreiben
            strFindAddressArry(intArrayIndex) = rngSuchbereich.Row
    
            'Nach der nächsten Übereinstimmung suchen
            Set rngSuchbereich = Sheets("Rohdaten").Columns(7).FindNext(rngSuchbereich)
        Loop While Not rngSuchbereich Is Nothing And rngSuchbereich.Address <> strFirstFindAddress
    
    End If
    
    If intArrayIndex > 0 Then
        'Blatt "Rohdaten" aufrufen
        Sheets("Rohdaten").Activate
        
        'Schleife um das eventuell gefüllte Array auszuwerten
        For intAddress = 1 To UBound(strFindAddressArry)
        
            'im Tabellenblatt "Rohdaten" die Zeile aus dem Array in Spalte B markieren
            Sheets("Rohdaten").Cells(CInt(strFindAddressArry(intAddress)), 7).Select
            
            'Wenn mehr als ein Eintrag im Array eine Abfrage anzeigen ob die nächste Übereinstimmung aufgerufen werden soll
            If intAddress < UBound(strFindAddressArry) Then _
                intAbfrage = MsgBox("Nächste Übereinstimmung anzeigen?", vbQuestion + vbYesNo, "Frage...")
            
            'Wenn Auswahl "Nein", dann an dieser Stelle den Code beenden
            If intAbfrage = 7 Then Exit Sub
        Next
    End If
    
    'Variable zurücksetzen
    Set rngSuchbereich = Nothing
End If

End Sub[/code]

MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]
0 Punkte
Beantwortet 11, Sep 2017 von Mitglied (259 Punkte)
okay

& Danke :)

hat mir sehr geholfen
...