Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 21:26:15
mehrfache Texte finden
19.04.2024 19:41:34
Bei VBA Ausführung Anzeige einfrieren
19.04.2024 17:05:40
Zählen von Zeilen, in denen in bestimmten Bereich Daten sind
19.04.2024 16:34:52
gemeinsamer Filter über drei Spalten
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1676to1680
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1676to1680
1676to1680
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Hyperlink VBA

Hyperlink VBA
18.02.2019 15:02:37
Thomas
Hallo zusammen,
stehe total auf dem Schlauch und bräuchte mal Hilfe...
Ich habe ThisWorkbook aus dem ich ein Makro starte.
Dann öffnet sich eine Eingabeaufforderung um ein Suchbegriff einzugeben.
Der Suchbegriff soll dann in allen offenen Workbooks und deren Sheets gesucht werden.
Wenn was gefunden wird, sollen der Ort als Hyperlink in ThisWorkbook eingetragen werden.
Ich bekomme das einfach nicht zum laufen.
Der Link wird eingetragen und wenn ich ihn benutze springe ich in die richtige mappe und ins richtige Sheet aber nicht in die richtige Zelle.
Da kommt dann immer "Der Bezug ist ungültig" oder manchmal nichts und man ist dann einfach nur in A1 des richtigen Sheets.
Irgendwo fehlt eine Zuweisung zum richtigen WB.
Vielleicht kann mir hier jemand helfen: 

Sub Alle_Offenen_Dateien()
Dim wkb As Workbook
Dim wks As Worksheet
Dim rngF As Range
Dim strFirstAddress As String
Dim strSuchbegriff As String
strSuchbegriff = InputBox(prompt:="Bitte Suchbegriff eingeben:", Title:="Suchbegriff")
For Each wkb In Application.Workbooks
For Each wks In wkb.Worksheets
If wks.Name  "Suche" Then
Set rngF = wks.Range("A1:O2000").Find(What:=strSuchbegriff)
If Not rngF Is Nothing Then
strFirstAddress = rngF.Address
Do
ThisWorkbook.Sheets(1).Hyperlinks.Add Anchor:=ThisWorkbook.Sheets(1). _
Range("R1"), Address:=wkb.FullName, SubAddress:=wks.Name & rngF.Address(0, 0)
var1 = wkb.FullName & wks.Name & rngF.Address
Set rngF = wks.Range("A1:O2000").FindNext
Loop While rngF.Address  strFirstAddress
End If
End If
Next wks
Next
End Sub

19
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
würdest du bitte...
18.02.2019 15:08:07
Werner
Hallo Thomas,
...deine Beiträge in den verschiedenen Foren untereinander verlinken. Es muss ja nicht unbedingt jemand für den Papierkorb arbeiten.
Gruß Werner
AW: Hyperlink VBA
18.02.2019 15:13:37
Thomas
Btw, was ist eigentlich mit dem provisorischen Forum von office-loesungen passiert ?
War früher dort recht aktiv, habe dann ewig nichts mehr mit vba gemacht und jetzt muss ich mich wieder etwas reinarbeiten.
Mir ist aufgefallen dass der Server scheinbar down ist, Dauerzustand ?
Anzeige
AW: Hyperlink VBA
18.02.2019 15:16:36
PeterK
Hallo
Vermutung: es fehlt "!"
SubAddress:=wks.Name & "!" & rngF.Address(0, 0)
AW: Hyperlink VBA
18.02.2019 15:29:26
Thomas
Hab es durch Zufall gerade rausbekommen.
Also ja, das ! muss natürlich da sein, allerdings hatte ich das auch schon probiert und das hatte auch nicht geklappt.
Das Problem ist wenn das Sheet ein Leerzeichen im Namen hat.
Wie bekomme ich das den jetzt in den Griff ?
AW: Hyperlink VBA
18.02.2019 15:32:26
PeterK
Hallo
Unter einfache Anfürungszeichen setzen
:= "'" & Wks.name & "'!" & ....
AW: Hyperlink VBA
18.02.2019 15:52:01
Thomas
Vielen Dank jetzt klappt alles!
Kannst Du auch irgendwas zu meiner anderen Frage über das office-loesungen Forum sagen ?
Anzeige
AW: Hyperlink VBA
18.02.2019 15:47:24
Werner
Hallo Thomas,
zu dem, was Peter schon angemerkt hat.
1. sollte man bei Find tunlichst die Parameter mit angeben (lookin, lookat). Excel speichert nämlich die Sucheinstellungen der letzten Suche ab. Wenn du die dann nicht angibst, kann es zu unerwünschten Ergebnissen führen.
Sollte dein Suchbegriff nicht alleine in der Zelle stehen, dann mußt du lookat von xlwhole auf xlpart ändern.
2. würde ich mal meinen, dass deine Weitersuche eigentlich nicht korrekt ist. Das sollte nämlich ....FindNext(rngF) lauten
3. Schreibst du dir den Hyperlink ja ständig in Zelle R1. Bei mehreren Treffern hättest du dann dort ja nur den Hyperlink des letzten Treffers
4. hast du eine Variable var1. Die verwendest du nicht, deklariert ist sie auch nicht.
5. setzt du die Variable rngF nicht wieder zurück. Sollte man bei Set immer machen.
Sub Alle_Offenen_Dateien()
Dim wkb As Workbook, wks As Worksheet, rngF As Range, i As Long
Dim strFirstAddress As String, strSuchbegriff As String
strSuchbegriff = InputBox(prompt:="Bitte Suchbegriff eingeben:", Title:="Suchbegriff")
i = 1
For Each wkb In Application.Workbooks
For Each wks In wkb.Worksheets
If wks.Name  "Suche" Then
Set rngF = wks.Range("A1:O2000").Find(What:=strSuchbegriff, LookIn:=xlValues, _
lookat:=xlWhole)
If Not rngF Is Nothing Then
strFirstAddress = rngF.Address
Do
ThisWorkbook.Sheets(1).Hyperlinks.Add Anchor:=ThisWorkbook.Sheets(1). _
Range("R" & i), Address:=wkb.FullName, SubAddress:="'" & wks.Name & "'!" _
& rngF.Address(0, 0)
i = i + 1
'var1 = wkb.FullName & wks.Name & rngF.Address
Set rngF = wks.Range("A1:O2000").FindNext(rngF)
Loop While rngF.Address  strFirstAddress
End If
End If
Next wks
Next wkb
Set rngF = Nothing
End Sub
Gruß Werner
Anzeige
AW: Hyperlink VBA
18.02.2019 15:54:41
Thomas
Hi Werner,
ich gucke mal was ich noch verbessern kann.
Die Punkte 3&4 sind überbleibsel meiner Tests.
Mein Code sieht jetzt so aus (ohne deine Verbesserungsvorschläge):
Sub Alle_Offenen_Dateien()
Dim wkb As Workbook
Dim wks As Worksheet
Dim rngF As Range
Dim strFirstAddress As String
Dim strSuchbegriff As String
strSuchbegriff = InputBox(prompt:="Bitte Suchbegriff eingeben:", Title:="Suchbegriff")
For Each wkb In Application.Workbooks
For Each wks In wkb.Worksheets
If wks.Name  "Suche" Then
Set rngF = wks.Range("A1:O2000").Find(What:=strSuchbegriff)
If Not rngF Is Nothing Then
strFirstAddress = rngF.Address
Do
With Application.ThisWorkbook.Worksheets(1)
anzR = .Cells(.Rows.Count, 17).End(xlUp).Row
For i = 1 To anzR
.Hyperlinks.Add Anchor:=.Cells(anzR + 1, 17), Address:=wkb. _
FullName, SubAddress:="'" & wks.Name & "'" & "!" & rngF.Address(0, 0), TextToDisplay:=i & ") " & wkb.Name & "\" & wks.Name
Next i
End With
Set rngF = wks.Range("A1:O2000").FindNext
Loop While rngF.Address  strFirstAddress
End If
End If
Next wks
Next
If i = "" Then
MsgBox strSuchbegriff & " wurde nicht gefunden"
End If
End Sub

Anzeige
AW: Hyperlink VBA
18.02.2019 15:58:21
Thomas
So, das müsste jetzt passen. Oder ?
Sub Alle_Offenen_Dateien()
Dim wkb As Workbook
Dim wks As Worksheet
Dim rngF As Range
Dim strFirstAddress As String
Dim strSuchbegriff As String
Dim anzR As Long
strSuchbegriff = InputBox(prompt:="Bitte Suchbegriff eingeben:", Title:="Suchbegriff")
For Each wkb In Application.Workbooks
For Each wks In wkb.Worksheets
If wks.Name  "Suche" Then
Set rngF = wks.Range("A1:O2000").Find(What:=strSuchbegriff, LookIn:=xlValues,  _
lookat:=xlPart)
If Not rngF Is Nothing Then
strFirstAddress = rngF.Address
Do
With Application.ThisWorkbook.Worksheets(1)
anzR = .Cells(.Rows.Count, 17).End(xlUp).Row
For i = 1 To anzR
.Hyperlinks.Add Anchor:=.Cells(anzR + 1, 17), Address:=wkb. _
FullName, SubAddress:="'" & wks.Name & "'" & "!" & rngF.Address(0, 0), TextToDisplay:=i & ") " & wkb.Name & "\" & wks.Name
Next i
End With
Set rngF = wks.Range("A1:O2000").FindNext(rngF)
'Set rngF = wks.Range("A1:O2000").FindNext
Loop While rngF.Address  strFirstAddress
End If
End If
Next wks
Next
If i = "" Then
MsgBox strSuchbegriff & " wurde nicht gefunden"
End If
Set rngF = Nothing
End Sub

Anzeige
AW: Hyperlink VBA
18.02.2019 16:22:28
Werner
Hallo Thomas,
würde ich ohne die For i = .... Schleife machen 
Option Explicit
Sub Alle_Offenen_Dateien()
Dim wkb As Workbook, wks As Worksheet
Dim rngF As Range, anzR As Long, boFund As Boolean
Dim strFirstAddress As String, strSuchbegriff As String
strSuchbegriff = InputBox(prompt:="Bitte Suchbegriff eingeben:", Title:="Suchbegriff")
For Each wkb In Application.Workbooks
For Each wks In wkb.Worksheets
If wks.Name  "Suche" Then
Set rngF = wks.Range("A1:O2000").Find(What:=strSuchbegriff, LookIn:=xlValues, _
lookat:=xlPart)
If Not rngF Is Nothing Then
boFund = True
strFirstAddress = rngF.Address
Do
With Application.ThisWorkbook.Worksheets(1)
anzR = .Cells(.Rows.Count, 17).End(xlUp).Row
.Hyperlinks.Add Anchor:=.Cells(anzR + 1, 17), Address:=wkb. _
FullName, SubAddress:="'" & wks.Name & "'" & "!" & rngF.Address(0, 0) _
, TextToDisplay:=anzR & ") " & wkb.Name & "\" & wks.Name
anzR = anzR + 1
End With
Set rngF = wks.Range("A1:O2000").FindNext(rngF)
Loop While rngF.Address  strFirstAddress
End If
End If
Next wks
Next
If Not boFund Then
MsgBox strSuchbegriff & " wurde nicht gefunden"
End If
Set rngF = Nothing
End Sub
Gruß Werner
Anzeige
AW: Hyperlink VBA
18.02.2019 16:29:06
Thomas
Ok, vielen Dank!
Wäre es sehr aufwendig wenn ich Komma separiert nach mehreren Begriffen suchen will ?
Da wüsste ich ehrlich gesagt nicht genau wo ich da anfangen müsste...
AW: Hyperlink VBA
18.02.2019 19:34:14
Werner
Hallo Thomas,
dann schreib dir doch deine "Suchbegriffe" untereinander in eine freie Spalte und geh in einer äußeren Schleife über die verschiedenen Suchbegriffe.
Ich bin im Beispiel jetzt einfach mal von deinem Worksheets(1) ausgegangen und habe einfach mal Spalte A von A1 bis ? genommen. Müsstest du dann ggf. anpassen. 
Option Explicit
Sub Alle_Offenen_Dateien()
Dim wkb As Workbook, wks As Worksheet, i As Long, loLetzte As Long
Dim rngF As Range, anzR As Long, boFund As Boolean
Dim strFirstAddress As String, strSuchbegriff As String
With ThisWorkbook.Worksheets(1)
loLetzte = .Cells(.Rows.count, 1).End(xlUp).Row
End With
Application.ScreenUpdating = False
For i = 1 To loLetzte
strSuchbegriff = ThisWorkbook.Worksheets(1).Cells(i, 1)
For Each wkb In Application.Workbooks
For Each wks In wkb.Worksheets
If wks.Name  "Suche" Then
Set rngF = wks.Range("A1:O2000").Find(What:=strSuchbegriff, LookIn:=xlValues, _
lookat:=xlPart)
If Not rngF Is Nothing Then
boFund = True
strFirstAddress = rngF.Address
Do
With Application.ThisWorkbook.Worksheets(1)
anzR = .Cells(.Rows.count, 17).End(xlUp).Row
.Hyperlinks.Add Anchor:=.Cells(anzR + 1, 17), Address:=wkb. _
FullName, SubAddress:="'" & wks.Name & "'" & "!" & rngF.Address(0,  _
0) _
, TextToDisplay:=anzR & ") " & wkb.Name & "\" & wks.Name
anzR = anzR + 1
End With
Set rngF = wks.Range("A1:O2000").FindNext(rngF)
Loop While rngF.Address  strFirstAddress
End If
End If
Next wks
Next wkb
Next i
If Not boFund Then
MsgBox strSuchbegriff & " wurde nicht gefunden"
End If
Set rngF = Nothing
End Sub
Gruß Werner
Anzeige
AW: Hyperlink VBA
19.02.2019 11:05:24
Thomas
Hallöle, wieder ich...
Ich habe mich jetzt für ein Array entschieden.
Außerdem möchte 2 Arten zum suchen haben, einmal in allen offenen WB's, und einmal in allen WB's in einem Pfad.
Das mit dem Pfad habe ich jetzt auch umgesetzt gehabt, jetzt versuche ich noch das Array hinzubekommen.
Leider hänge ich hin und wieder in der folgenden Do Schleife endlos fest:
Do
With Application.ThisWorkbook.Worksheets(1)
anzR = .Cells(.Rows.Count, 17).End(xlUp).Row
.Hyperlinks.Add Anchor:=.Cells(anzR + 1, 17), Address:=wkb.FullName, SubAddress:="'" & wks.Name & "'" & "!" & rngF.Address(0, 0), TextToDisplay:=i & ") " & wkb.Name & "\" & wks.Name
anzR = anzR + 1
End With
Set rngF = wks.Range("A1:EA1000").FindNext(rngF)
Loop While rngF.Address strFirstAddress
Hier nochmal der ganz Code:
Sub Alle_Dateien_inPfad()
Dim wkb As Workbook
Dim wks As Worksheet
Dim rngF As Range
Dim strFirstAddress As String
Dim strSuchbegriff As String
Dim anzR As Long
Dim sSuche As String
Dim sSuchArray() As String
Dim y As Integer
Application.ScreenUpdating = False
Set rngF = Nothing
sPath = "C:\temp\1\"                      'Pfad anpassen aber das letzte "\" darf nicht fehlen
sFile = Dir(sPath & "*.xls*")
strSuchbegriff = InputBox(prompt:="Bitte Suchbegriff eingeben:", Title:="Suchbegriff")
sSuchArray() = Split(strSuchbegriff, ",")
Do While sFile  ""
Set wkb = Workbooks.Open(sPath & sFile)
For y = LBound(sSuchArray) To UBound(sSuchArray)
For Each wks In wkb.Worksheets
If wks.Name  "Suche" Then
Set rngF = wks.Range("A1:EA1000").Find(What:=sSuchArray(i), LookIn:=xlValues, _
lookat:=xlPart)
If Not rngF Is Nothing Then
strFirstAddress = rngF.Address
Do
With Application.ThisWorkbook.Worksheets(1)
anzR = .Cells(.Rows.Count, 17).End(xlUp).Row
.Hyperlinks.Add Anchor:=.Cells(anzR + 1, 17), Address:= _
wkb.FullName, SubAddress:="'" & wks.Name & "'" & "!" & rngF.Address(0, 0), TextToDisplay:=i & ") " & wkb.Name & "\" & wks.Name
anzR = anzR + 1
End With
Set rngF = wks.Range("A1:EA1000").FindNext(rngF)
Loop While rngF.Address  strFirstAddress
End If
End If
Next wks
Next y
wkb.Close Savechanges = True
sFile = Dir()
Loop
If i = "" Then
'MsgBox strSuchbegriff & " wurde nicht gefunden"
End If
Set rngF = Nothing
Application.ScreenUpdating = True
End Sub
Siehst du wo ich den Fehler mache ?
Anzeige
AW: Hyperlink VBA
19.02.2019 14:01:37
Werner
Hallo Thomas,
teste mal: 
Option Explicit
Sub Alle_Dateien_inPfad()
Dim wkb As Workbook, wks As Worksheet, rngF As Range
Dim strFirstAddress As String, sPath As String, sFile As String
Dim sSuche As String, sSuchArray() As String
Dim anzR As Long, y As Long
Application.ScreenUpdating = False
sPath = "C:\temp\1\" 'Pfad anpassen aber das letzte "\" darf nicht fehlen
sFile = Dir(sPath & "*.xls*")
'du kannst das Array auch direkt über die Inputbox füllen
sSuchArray() = Split(InputBox(prompt:="Bitte Suchbegriff eingeben:", _
Title:="Suchbegriff"), ",")
Do While sFile  ""
Set wkb = Workbooks.Open(sPath & sFile)
For y = LBound(sSuchArray) To UBound(sSuchArray)
For Each wks In wkb.Worksheets
If wks.Name  "Suche" Then
'hier hattest du sSuchArray(i), i wurde aber nie belegt
'war also immer 0, also hast du immer nur nach dem ersten
'Wert im Array gesucht
Set rngF = wks.Range("A1:EA1000").Find(What:=sSuchArray(y), _
LookIn:=xlValues, lookat:=xlPart)
If Not rngF Is Nothing Then
strFirstAddress = rngF.Address
Do
With Application.ThisWorkbook.Worksheets(1)
anzR = .Cells(.Rows.Count, 17).End(xlUp).Row
.Hyperlinks.Add Anchor:=.Cells(anzR + 1, 17), Address:= _
wkb.FullName, SubAddress:="'" & wks.Name & "'" & "!" & _
rngF.Address(0, 0), TextToDisplay:=anzR & ") " & _
wkb.Name & "\" & wks.Name
anzR = anzR + 1
End With
Set rngF = wks.Range("A1:EA1000").FindNext(rngF)
Loop While rngF.Address  strFirstAddress
End If
End If
Next wks
Next y
'wieso Speichern? an der geöffneten Datei
'wird doch nichts geändert
wkb.Close False
'wkb.Close Savechanges = True
sFile = Dir()
Loop
Set rngF = Nothing: Set wkb = Nothing
End Sub
Gruß Werner
Anzeige
AW: Hyperlink VBA
19.02.2019 14:27:10
Thomas
Hey, vielen Dank für Deine Mühe!
Leider habe ich den Loop auch weiterhin....
Hilft Dir eine Aufnahme von der Einzelschritt Aufnahme ?
https://www.youtube.com/watch?v=AzDstTisRT4&feature=youtu.be
AW: Hyperlink VBA
19.02.2019 16:16:41
Thomas
Ich konnte auf jeden Fall mal rausfinden, dass rnnF.Address irgendwann zb den Wert $C$101 bekommt und strFirstAddress den Wert $C$101:$C$101.
Dann unterscheidet es sich und der Loop beginnt durch das Loop While rngF.Address strFirstAddress
Aber ich hab keine Ahnung was ich jetzt tun muss...
AW: Hyperlink VBA
20.02.2019 09:33:16
Thomas
Wenn ich noch irgendwas tun kann um etwas zur Lösung beizusteuern, dann immer raus damit ;)
AW: Hyperlink VBA
20.02.2019 15:58:43
Thomas
ich weiß, Crossposting ist nicht so gern gesehen aber ich verlinke hier auf jeden Fall mal die Posts...
https://www.ms-office-forum.net/forum/showthread.php?p=1916069#post1916069

Links zu Excel-Dialogen

InputBox

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige