Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1576to1580
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
Inhaltsverzeichnis

suchen des Wertes in der Zwischenablage

suchen des Wertes in der Zwischenablage
01.09.2017 08:37:15
Andreas
Hallo zusammen,
mein Problem ist Folgendes: ich habe zwei geöffnete Excelfiles. Im der ersten gibt es eine Nummer, nach der ich in der zweiten suchen möchte. Dann möchte ich den damit verbundenen link kopieren und wieder in die erste einfügen.
Ich muss dazu sagen, das ich Einsteiger bei VBA bin. Ich wollte also so vorgehen, dass ich die Zahl in ersten Tabelle (file1) in die Zwischenablage kopiere, in die zweite Tabelle (file 2) gehe und dort nach dieser Zahl in einer Spalte suche. Da dieser Wert im link enthalten ist, sollte diese Zelle aktiviert werden, so dass ich den link in die Zwischenablage kopieren kann. Ist das einigermaßen verständlich?
Über Hilfe würde ich mich sehr, sehr freuen.
VG
Andreas

22
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: suchen des Wertes in der Zwischenablage
01.09.2017 08:48:20
Michael
Hallo Andreas!
Klingt möglich, so wie Du es beschreibst allerdings etwas nach "von hinten durch die Brust ins Auge" ;-), daher zur Klärung ein paar Fragen:
Da dieser Wert im link enthalten ist
- Welcher Art sind die Hyperlinks? Mittels Formel erzeugt, also =HYPERLINK(...), oder manuell erzeugt mittels Kontextmenü (ReMaus-Klick in Zelle) und "Hyperlink..."?
- Warum soll der Hyperlink in die Zwischenablage? Soll die Linkadresse geöffnet werden (Browser) oder willst Du den Link in einem anderen Programm einfügen...?
- Wie sehen Deine Hyperlinks grds. aus? Verfolgen die ein Schema und was bedeutet "Wert im Link enthalten"? Zeig doch mal, wie Deine Links so aussehen.
- Suchst Du wirklich nur nach einer Nummer oder hast Du in Mappe 1 eine Liste von Nummern die, der Reihe nach, in Mappe 2 gesucht werden sollen (wobei dann jeweils mit den gefundenen Links etwas passieren soll...)?
- Wie willst Du nach der Nummer suchen? Klickst Du auf die Zelle, oder willst Du eine Eingabe-Meldung?
LG
Michael
Anzeige
AW: suchen des Wertes in der Zwischenablage
01.09.2017 10:19:14
Andreas
Hallo Michael,
erst mal Danke für die schnelle Antwort.
-Der link wird wie folgt erstellt:
ActiveSheet.Hyperlinks.Add anchor:=Cells(zelle.Row, zelle.Column + 1)
mit dem link wird gleichzeitig auch ein Ordner erstellt, in dem Daten abgelegt werden. Es gibt am Ende sechs Excel-Listen und von allen Listen sollen die links eingesammelt werden, die ein gemeinsames Merkmal haben (Stamm-Nummer). Die links sollen halt in die Zeile geschrieben werden, in der sich die Stammnummer befindet.Damit hat man schnell den Zugriff auf die entsprechenden Ordner (es gibt pro Jahr tausende solche Nummern, so dass das Suchen einfach viel Zeit kostet.
-Ich suche immer nach einer Nummer: Markieren der Stamm-Nummer und dann alle links dazu einsammeln.
- die links haben folgendes Schema: ABC170001_1234567, wobei 1234567 einfach die Stamm-Nummer ist, ABC das Kürzel der Liste und 1234567 die Stamm-Nummer.
VG
Andreas
Anzeige
Zeig mir mal eine kleine Beispiel-Mappe...
01.09.2017 10:24:26
Michael
Andreas,
...es müssen nicht 2 Mappen sein (wie bei Deinem Original), die Bsp-Daten können ruhig in einer Mappe aber in zwei Tabellenblättern stehen. Mir reicht wirklich nur eine kurze Darstellung Deiner Blatt-Strukturen, und vielleicht 1, 2 Ergebnisse - wo soll welcher Hyperlink stehen. Dann setze ich Dir das um!
LG
Michael
Nochmal Rückfrage
01.09.2017 12:18:50
Michael
Hallo Andreas!
Danke für die Bsp-Datei - die ist schon wichtig, weil wir sonst ewig aneinander vorbei sprechen.
Nochmal für mein Verständnis:
- Die drei Blätter "ABC", "DEF" bzw. "GHI" sind im Original jeweils in einer eigenen Arbeitsmappe?
- Sind in diesen Arbeitsmappen auch andere Blätter vorhanden? Falls ja, wie kann das Blatt, das nach den Hyperlinks durchsucht werden soll identifiziert werden (ist es zB immer das 1. Blatt der Mappe)?
- Sind die Arbeitsmappen, die Du durchsuchen willst immer bereits parallel geöffnet? Wenn ja, wieviele davon gleichzeitig?
- Zur Vorgehensweise (anhand Deinem Bsp-Blatt "ABC"): Du wählst (Maus oder Tastatur) Zelle C2 aus und klickst dann auf "Links einsammeln". Du willst dann von einem anderen Blatt (in einer anderen Mappe) ALLE Hyperlinks holen, die der Nummer in C2 entsprechen. Diese Links sollen dann zellenweise, rechts neben C2, eingefügt werden.
Richtig?
LG
Michael
Anzeige
AW: Nochmal Rückfrage
01.09.2017 12:47:37
Andreas
- Die drei Blätter "ABC", "DEF" bzw. "GHI" sind im Original jeweils in einer eigenen Arbeitsmappe? Ja
- Sind in diesen Arbeitsmappen auch andere Blätter vorhanden? Falls ja, wie kann das Blatt, das nach den Hyperlinks durchsucht werden soll identifiziert werden (ist es zB immer das 1. Blatt der Mappe)?
Ja. Es gibt identische Blätter, die mit einer Jahreszahl versehen sind. Los geht es mit 2017
- Sind die Arbeitsmappen, die Du durchsuchen willst immer bereits parallel geöffnet? Wenn ja, wieviele davon gleichzeitig?
Nein. Mein bisheriger Ansatz ist, dass das Makro die entsprechenden Listen öffnet, die links einsammelt und wieder schließt. Das habe ich auch schon erfolgreich gebastelt.
- Zur Vorgehensweise (anhand Deinem Bsp-Blatt "ABC"): Du wählst (Maus oder Tastatur) Zelle C2 aus und klickst dann auf "Links einsammeln". Du willst dann von einem anderen Blatt (in einer anderen Mappe) ALLE Hyperlinks holen, die der Nummer in C2 entsprechen. Diese Links sollen dann zellenweise, rechts neben C2, eingefügt werden.
ja, also die die Nummer zumindest enthalten.
LG
Andreas
Anzeige
Ok, dann...
01.09.2017 13:03:27
Michael
Andreas,
...zeig mir doch bitte diesen, Deinen Code:
dass das Makro die entsprechenden Listen öffnet, die links einsammelt und wieder schließt. Das habe ich auch schon erfolgreich gebastelt.
Dann kann ich Dir hoffentlich direkt einpflegen, was Dir noch fehlt (auf Basis Deiner Bsp-Datei).
LG
Michael
AW: Ok, dann...
01.09.2017 13:58:50
Andreas
Hallo Michael,
also das Problem beginnt in der kursiven Zeile. Wenn ich das mit dem Rekorder aufnehme, sucht er nicht nach dem kopierten Wert, sondern kopiert einfach immer die Zelle B2. Angangs dachte ich: toll, klappt ja. Bis ich mal was verändert habe und nat. immer wieder dieselben links eingesammelt habe :-(
LG
Andreas
Sub Makro1()
' Makro1 Makro
Workbooks.Open Filename:="I:\Databook\Databook_GHI.xls", ReadOnly:=True
Workbooks.Open Filename:="I:\Databook\Databook_FGH.xls", ReadOnly:=True
Workbooks.Open Filename:="I:\Databook\Databook_DEF.xls", ReadOnly:=True
Workbooks.Open Filename:="I:\Databook\Databook_ABC.xls", ReadOnly:=True
Workbooks.Open Filename:="I:\Databook\Databook_EFG.xls", ReadOnly:=True
Windows("Databook_BCD.xls").Activate
ActiveCell.Select
Selection.Copy
Windows("Databook_GHI.xls").Activate
Columns("b:b").Select
Windows("Databook_FGH.xls").Activate
Columns("B:B").Select
Windows("Databook_DEF.xls").Activate
Range("B2").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Databook_BCD.xls").Activate
ActiveCell.Offset(0, 18).Select
ActiveSheet.Paste
Windows("Databook_ABC.xls").Activate
Range("B2").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Databook_BCD.xls").Activate
ActiveCell.Offset(0, 1).Select
ActiveSheet.Paste
Windows("Databook_EFG.xls").Activate
Range("B2").Select
Application.CutCopyMode = Falsen
Selection.Copy
Windows("Databook_BCD.xls").Activate
ActiveCell.Offset(0, 1).Select
ActiveSheet.Paste
Windows("Databook_EFG.xls").Activate
ActiveWindow.Close , SaveChanges:=False
Windows("Databook_ABC.xls").Activate
ActiveWindow.Close , SaveChanges:=False
Windows("Databook_DEF.xls").Activate
ActiveWindow.Close , SaveChanges:=False
Windows("Databook_FGH.xls").Activate
ActiveWindow.Close , SaveChanges:=False
Windows("Databook_GHI.xls").Activate
ActiveWindow.Close , SaveChanges:=False
End Sub

Anzeige
Teste mal...
01.09.2017 15:01:52
Michael
...folgenden Code, mal sehen, ob ich Dich richtig verstanden habe.
Dazu noch ein paar Anmerkungen:
- Code bitte in einer Kopie jener Datei testen, in der Du die Hyperlinks sammeln möchtest. Mit den geöffneten Dateien passiert nichts, aber es könnte sein, dass in der "Sammel"-Datei Dinge überschrieben werden, die nicht überschrieben werden sollen.
- Der Code geht davon aus, dass Du in der Ausgangs-Datei, in der Du die HL sammeln willst, bereits eine Zelle mit der Stammnummer, nach der Du suchen willst, markiert hast.
- Der Code geht dann alle .xls-Dateien Deines Hauptpfades durch, die mit "Databook_" beginnen, deren Name aber nicht gleich dem der Ausgangsmappe ist. Jede so gefundene Datei wird geöffnet, jedes Tabellenblatt in dieser Mappe durchgegangen und jeder darin befindliche Hyperlink wird auf Vorkommen der StammNr geprüft; ist die StammNr teil des HL-Anzeigetextes, dann wird dieser Hyperlink in die nächste Zelle rechts der Ausgangszelle übertragen.
- Die geöffneten Dateien werden immer ohne Änderungen geschlossen.
Sub CollectHyperlinks()
Const HAUPTPFAD$ = "I:\Databook\"
Const PRE$ = "Databook_"
Dim WbQ As Workbook: Set WbQ = ThisWorkbook
Dim WbZ As Workbook, Ws As Worksheet, Hl As Hyperlink
Dim Datei$, SuchNr$, StammNrZelle As Range, c As Range, i&
Application.ScreenUpdating = False
Datei = Dir(HAUPTPFAD & PRE & "*.xls")
Set StammNrZelle = ActiveCell
Do Until Datei = vbNullString
If Datei  WbQ.Name Then
Set WbZ = Workbooks.Open(HAUPTPFAD & Datei)
SuchNr = StammNrZelle.Text
With WbZ
For Each Ws In .Worksheets
For Each Hl In Ws.Hyperlinks
If InStr(1, Hl, SuchNr) Then
i = i + 1
Set c = StammNrZelle.Offset(, i)
c.Hyperlinks.Add anchor:=c, Address:=Hl.Address, _
TextToDisplay:=Hl.TextToDisplay
End If
Next Hl
Next Ws
.Close False
End With
End If
i = 0: Set WbZ = Nothing
Datei = Dir
Loop
Set WbQ = Nothing: Set WbZ = Nothing
Set StammNrZelle = Nothing: Set c = Nothing
End Sub
Gib Bescheid - falls ich heute nicht mehr reagiere (bin schon bald im WE) dann schaue ich am Montag wieder rein.
LG
Michael
Anzeige
AW: Teste mal...
01.09.2017 16:17:40
Andreas
Hallo Michael,
läuft noch nicht ganz. Stockt bei der Zeile:
If InStr(1, Hl, SuchNr) Then
Da kommt ein Laufzeitfehler: Objekt unterstützt diese Eigenschaft oder Methode nicht.
Er öffnet die erste Datei und stirbt dann ab.
kann es sein, dass er die Stammzahl findet (Spalte C) statt des links in Spalte B?
LG
Andreas
Ah, da fehlt nur eine Kleinigkeit...
01.09.2017 20:47:30
Michael
Andreas,
versuch's mal so:
If InStr(1, Hl.TextToDisplay, SuchNr)
Dann sollte das laufen.
LG und schönes Wochenende
Michael
AW: Ah, da fehlt nur eine Kleinigkeit...
01.09.2017 21:47:18
Andreas
Hallo Michael,
vielen Dank schaut sehr gut aus! So richtig kann ich es erst am Montag auf Arbeit testen. Aber es kopiert schon erstmal die links zweier dummy-files :-) Zauberei!
LG
Andreas
Anzeige
Klingt gut, gib Bescheid! lg und schönes We! owT
01.09.2017 22:27:21
Michael
AW: Klingt gut, gib Bescheid! lg und schönes We! owT
02.09.2017 13:04:05
Andreas
Hallo Michael,
zwei Dinge sind mir noch aufgefallen.
1) wie kann ich die links ab Spalte "u" eintragen lassen (hatte gedacht ich könne das einfach über "i" ändern, geht aber nicht...)
2) wenn ich in der ersten Liste die links eingesammelt habe und dann dasselbe mit der zweiten, dritten, usf. mache, sammelt das Makro natürlich auch die bereits eingesammelten links mit ein. so kommt es nat. zu Dopplungen. Kann man das irgendwie vermeiden? Vielleicht kann man ihm sagen, dass er nur in Spalte "B" sammeln soll? ich habe nur 5 Felder zur Verfügung...
Danke und LG,
Andreas
Ergänzt... Teste mal...
04.09.2017 09:11:48
Michael
Guten Morgen Andreas,
...folgenden Code:
Sub CollectHyperlinks()
Const HAUPTPFAD$ = "I:\Databook\"
Const PRE$ = "Databook_"
Dim WbQ As Workbook: Set WbQ = ThisWorkbook
Dim WbZ As Workbook, Ws As Worksheet, Hl As Hyperlink
Dim Datei$, SuchNr$, StammNrZelle As Range
Dim d As Object, c As Range, i&
Application.ScreenUpdating = False
Datei = Dir(HAUPTPFAD & PRE & "*.xls")
Set d = CreateObject("Scripting.Dictionary")
Set StammNrZelle = ActiveCell
Do Until Datei = vbNullString
If Datei  WbQ.Name Then
Set WbZ = Workbooks.Open(HAUPTPFAD & Datei)
SuchNr = StammNrZelle.Text
With WbZ
For Each Ws In .Worksheets
For Each Hl In Ws.Hyperlinks
If InStr(1, Hl.TextToDisplay, SuchNr) Then
If Not d.exists(Hl.TextToDisplay) Then
d.Add Hl.TextToDisplay, ""
Set c = Cells(StammNrZelle.Row, "U").Offset(, i)
c.Hyperlinks.Add anchor:=c, Address:=Hl.Address, _
TextToDisplay:=Hl.TextToDisplay
i = i + 1
End If
End If
Next Hl
Next Ws
.Close False
End With
End If
Set WbZ = Nothing
Datei = Dir
Loop
Set WbQ = Nothing: Set WbZ = Nothing
Set StammNrZelle = Nothing: Set c = Nothing
d.RemoveAll: Set d = Nothing
End Sub
Passt?
LG
Michael
Anzeige
AW: Ergänzt... Teste mal...
04.09.2017 09:50:06
Andreas
Guten Morgen Michael,
funzt leider nicht. Er bleibt bei .Close False hängen kopiert aber auch keine links. komischerweise funktioniert letzteres mit dem vorangegangenen Makro (halt nur in die falsche Spalte).
Zudem muss ich (weil die Dateien so angelegt sind) jedes mal bestätigen, dass er die schreibgeschützt öffnet. kann man das aushebeln?
LG
Andreas
Versuch's mal so...
04.09.2017 09:59:59
Michael
Andreas,
Sub CollectHyperlinks()
Const HAUPTPFAD$ = "I:\Databook\"
Const PRE$ = "Databook_"
Dim WbQ As Workbook: Set WbQ = ThisWorkbook
Dim WbZ As Workbook, Ws As Worksheet, Hl As Hyperlink
Dim Datei$, SuchNr$, StammNrZelle As Range
Dim d As Object, c As Range, i&
Application.ScreenUpdating = False
Datei = Dir(HAUPTPFAD & PRE & "*.xls")
Set d = CreateObject("Scripting.Dictionary")
Set StammNrZelle = ActiveCell
Do Until Datei = vbNullString
If Datei  WbQ.Name Then
Set WbZ = Workbooks.Open(Filename:=HAUPTPFAD & Datei, ReadOnly:=True)
SuchNr = StammNrZelle.Text
With WbZ
For Each Ws In .Worksheets
For Each Hl In Ws.Hyperlinks
If InStr(1, Hl.TextToDisplay, SuchNr) Then
If Not d.exists(Hl.TextToDisplay) Then
d.Add Hl.TextToDisplay, ""
Set c = WbQ.ActiveSheet.Cells(StammNrZelle.Row, _
"U").Offset(, i)
c.Hyperlinks.Add anchor:=c, Address:=Hl.Address, _
TextToDisplay:=Hl.TextToDisplay
i = i + 1
End If
End If
Next Hl
Next Ws
.Close
End With
End If
Set WbZ = Nothing
Datei = Dir
Loop
Set WbQ = Nothing: Set WbZ = Nothing
Set StammNrZelle = Nothing: Set c = Nothing
d.RemoveAll: Set d = Nothing
End Sub
LG
Michael
Anzeige
AW: Versuch's mal so...
04.09.2017 10:39:35
Andreas
Hallo Micha,
funktioniert fast perfekt. Einziger Schönheitsfehler: er fragt nun jedes mal, ob er vorm schließen speichern soll.
Danke und LG
Andreas
Aber jetzt...
04.09.2017 10:50:16
Michael
Andreas,
...sollte wirklich alles abgedeckt sein ;-):
Sub CollectHyperlinks()
Const HAUPTPFAD$ = "I:\Databook\"
Const PRE$ = "Databook_"
Dim WbQ As Workbook: Set WbQ = ThisWorkbook
Dim WbZ As Workbook, Ws As Worksheet, Hl As Hyperlink
Dim Datei$, SuchNr$, StammNrZelle As Range
Dim d As Object, c As Range, i&
Application.ScreenUpdating = False
Datei = Dir(HAUPTPFAD & PRE & "*.xls")
Set d = CreateObject("Scripting.Dictionary")
Set StammNrZelle = ActiveCell
Do Until Datei = vbNullString
If Datei  WbQ.Name Then
Set WbZ = Workbooks.Open(Filename:=HAUPTPFAD & Datei, ReadOnly:=True)
SuchNr = StammNrZelle.Text
With WbZ
For Each Ws In .Worksheets
For Each Hl In Ws.Hyperlinks
If InStr(1, Hl.TextToDisplay, SuchNr) Then
If Not d.exists(Hl.TextToDisplay) Then
d.Add Hl.TextToDisplay, ""
Set c = WbQ.ActiveSheet.Cells(StammNrZelle.Row, _
"U").Offset(, i)
c.Hyperlinks.Add anchor:=c, Address:=Hl.Address, _
TextToDisplay:=Hl.TextToDisplay
i = i + 1
End If
End If
Next Hl
Next Ws
.Close False
End With
End If
Set WbZ = Nothing
Datei = Dir
Loop
Set WbQ = Nothing: Set WbZ = Nothing
Set StammNrZelle = Nothing: Set c = Nothing
d.RemoveAll: Set d = Nothing
End Sub
LG
Michael
AW: Aber jetzt...
04.09.2017 10:54:33
Andreas
Perfekt! Genau das soll das makro machen! Ganz, ganz vielen Dank für Deine Hilfe!
LG
Andreas
(sorry den letzten Beitrag hab ich versehentlich zweimal abgeschickt)
Super, freut mich! Danke für die Rückmeldung, owT
04.09.2017 11:05:10
Michael
AW: Versuch's mal so...
04.09.2017 10:50:44
Andreas
Hallo Micha,
funktioniert fast perfekt. Einziger Schönheitsfehler: er fragt nun jedes mal, ob er vorm schließen speichern soll.
Danke und LG
Andreas

302 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige