Microsoft Excel

Herbers Excel/VBA-Archiv

Teil von Hyperlinks ausgeben

Betrifft: Teil von Hyperlinks ausgeben von: Christian
Geschrieben am: 01.09.2014 11:38:20

Hallo an alle,

ich hoffe ihr könnt mir helfen.

Hänge mal eine Beispieltabelle an.

Wäret ihr so nett und helft mir mit einem Makro aus.
Es geht mir darum, wenn ihr euch die Tabelle 1 anguckt, die Zeilen, die mit Season anfangen, haben alle einen Hyperlink.

Ich nehme jetzt mal als Beispiel den ersten Hyperlink

http://www.imdb.com/title/tt2741110/

für den Teil tt2741110 habe ich eine Liste in Tabelle2

Also wäre es schön, wenn das Makro diese 9 Hyperlink-Teile zu den bereits in Tabelle2 bestehenden Teilen am Ende hinzufügt, Tabelle2 dann nach Spalte A aufsteigend sortiert und Tabelle1 komplett wieder leert, also auch die Bilder.

Die anderen Hyperlinks in Tabelle1 sind uninteressant, es geht nur um die Zeilen die mit Season anfangen.

Die Seite ist jetzt nur ein Beispiel, es kann auch sein, dass es mal Serien betrifft, die 10000 + Episoden haben.

Kann mir da jemand helfen?

https://www.herber.de/bbs/user/92420.xlsx
Gruß
Christian

  

Betrifft: AW: Teil von Hyperlinks ausgeben von: Rudi Maintaire
Geschrieben am: 01.09.2014 12:06:20

Hallo,
für den ersten Teil:

Sub aa()
  Dim hl As Hyperlink, s, ttd
  For Each hl In Sheets(1).Hyperlinks
    On Error Resume Next
    ttd = hl.TextToDisplay
    On Error GoTo 0
    If ttd Like ("Season*") Then
      s = Split(hl.Address, "/")
      s = s(UBound(s) + (s(UBound(s)) = ""))
      Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1) = s
    End If
  Next
End Sub
Gruß
Rudi


  

Betrifft: AW: Teil von Hyperlinks ausgeben von: Christian
Geschrieben am: 01.09.2014 12:17:29

Hallo Rudi,

das funktioniert ja schonmal. Danke. Gibt es denn auch noch eine Lösung für den zweiten Teil?

Dürfte ich vielleicht noch eine Bitte äußern, dass das Makro auch das Datum, das unterhalb des jeweiligen Hyperlinks steht, auch in Tabelle2 kopiert wird, jeweils in dieselbe Zeile wie der Link, in Spalte C?

Danke und Gruß
Christian


  

Betrifft: AW: Teil von Hyperlinks ausgeben von: Rudi Maintaire
Geschrieben am: 01.09.2014 12:29:19

Hallo,
komplett:

Sub aa()
  Dim hl As Hyperlink, s, ttd
  For Each hl In Sheets(1).Hyperlinks
    On Error Resume Next
    ttd = hl.TextToDisplay
    On Error GoTo 0
    If ttd Like ("Season*") Then
      s = Split(hl.Address, "/")
      s = s(UBound(s) + (s(UBound(s)) = ""))
      With Sheets(2).Cells(Rows.Count, 1).End(xlUp)
        .Offset(1) = s
        .Offset(1, 1) = hl.Parent.Offset(2)
      End With
    End If
  Next
  With Sheets(2)
    .Range("A1").Sort key1 = .Range("A1"), order1:=xlAscending, Header:=xlNo
  End With
  With Sheets(1)
    .Cells.Clear
    .DrawingObjects.Delete
  End With
End Sub

Gruß
Rudi


  

Betrifft: AW: Teil von Hyperlinks ausgeben von: Christian
Geschrieben am: 01.09.2014 12:45:26

Hallo Rudi,

hänge mal nochmal eine Datei an. Leider klappt es nicht so ganz. Die Links werden in Tabelle2 geschrieben, die Daten auch, jedoch in Spalte B statt in Spalte C.

Aber dann bekomm ich eine Fehlermeldung, in der nur 400 steht, es wird weder sortiert, noch irgenwas gelöscht.

Gruß
Chris

https://www.herber.de/bbs/user/92421.xlsx


  

Betrifft: AW: Teil von Hyperlinks ausgeben von: Rudi Maintaire
Geschrieben am: 01.09.2014 12:50:59

Hallo,
noch'n Versuch:

Sub aa()
  Dim hl As Hyperlink, s, ttd
  For Each hl In Sheets(1).Hyperlinks
    On Error Resume Next
    ttd = hl.TextToDisplay
    On Error GoTo 0
    If ttd Like ("Season*") Then
      s = Split(hl.Address, "/")
      s = s(UBound(s) + (s(UBound(s)) = ""))
      With Sheets(2).Cells(Rows.Count, 1).End(xlUp)
        .Offset(1) = s
        .Offset(1, 2) = hl.Parent.Offset(2)
      End With
    End If
  Next
  With Sheets(2)
    .Range("A:B").Sort key1:=.Range("A1"), order1:=xlAscending, Header:=xlNo
  End With
  With Sheets(1)
    .Cells.Clear
    .DrawingObjects.Delete
  End With
End Sub



  

Betrifft: AW: Teil von Hyperlinks ausgeben von: Christian
Geschrieben am: 01.09.2014 13:01:55

Hallo Rudi, das sieht doch mal super aus,

danke.

Christian


  

Betrifft: AW: Teil von Hyperlinks ausgeben von: czender
Geschrieben am: 02.09.2014 08:00:33

Hallo Rudi,

ich bitte dich noch einmal kurz um Hilfe.

Da ich jetzt anderen Text in Tabelle1 eingefügt habe, ist es notwendig, dass nicht nur Season* als Suchkriterium sondern auch Episode* als Suchkriterium, beides nur wenn es an Anfang der Zelle steht genommen werden soll? Lässt sich Episode* noch irgendwie als 2. Kriterium hinzufügen?

Gruß
Christian


  

Betrifft: AW: Teil von Hyperlinks ausgeben von: Rudi Maintaire
Geschrieben am: 02.09.2014 09:51:20

Hallo,
so schwer ist das nu auch wieder nicht.

If ttd Like ("Season*") Or ttd Like ("Episode*") Then

Gruß
Rudi


  

Betrifft: AW: Teil von Hyperlinks ausgeben von: czender
Geschrieben am: 02.09.2014 09:57:10

Hallo Rudi,

ich hab zwar ein wenig Ahnung von C++ und Java, aber VBA is für mich leider Neuland. Ich gebe zu, an sowas Ähnliches habe ich bereits gedacht, hätte aber als Laie If ttd Like ("Season*" or "Episode*") geschrieben und wäre dann ja offensichtlich damit kläglich gescheitert.

Danke jedenfalls
Christian


 

Beiträge aus den Excel-Beispielen zum Thema "Teil von Hyperlinks ausgeben"