Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1412to1416
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

Hyperlink auslesen und aufteilen in Zellen

Hyperlink auslesen und aufteilen in Zellen
12.03.2015 17:19:02
Stef@n
Hallo Excel-Freunde
ich stehe vor folgender Aufgabe:
Ein Sharepoint-Inhalt wird in Excel mittels einer Liste (Listenverknüpfung) "importiert"
Dabei wird in Spalte 1 die ID eingetragen,
in Spalte 2 der Dateiname (als Hyperlink) eingefügt,
in Spalte 3 das Änderungsdatum
in Spalte 4 der letzte Bearbeiter
Jetzt möchte in diesen Hyperlink "auslesen"
Hierzu habe ich ein Makro
Option Explicit
Function HyperlinkAdresse(Zelle As Range)
Dim Link As String
Application.Volatile
If Zelle.Hyperlinks.Count Then
Link = Zelle.Hyperlinks(1).Address
End If
HyperlinkAdresse = Link
End Function
das mir den kompletten Hyperlink ausliest.
Beispiel:
https://collaboration.intranet.Firma.com/Team%2FTOOL%2Fteam_1%2FFortschritt%2F1000%2FBereich%2FAbteilung Name %28W1%29%2FDokumentation_v01.ppt
Da die Sonderzeichen beim lesen usw störend sind, müsste jetzt folgendes
(per Formel oder wie auch immer) passieren
Ersetzen von
%2F = /
%20 = Leerzeichen
%28 = (
%29 = )
Das habe ich bisland per "Suchen Ersetzen" gemacht
Dann sieht das Ergebnis so aus
https://collaboration.intranet.Firma.com/Team/TOOL/team_1/Fortschritt/1000/Bereich/Abteilung Name (W1)/Dokumentation_v01.ppt
Anschliessend möchte ich diese Adresse aufteilen - folgendes jeweils in eine Spalte daneben
Ergebnisse in mehreren Spalten
(ist immer gleich:
https://collaboration.intranet.Firma.com/Team/TOOL
(ist immer unterschiedlich:
Team_1
Fortschritt
1000
Bereich
Abteilung Name (W1)
Dokumentation_v01.ppt
Die Krux: manchmal kann es sein, dassnach dem /Abteilung Name (W1)
noch weitere unterordner kommen
Wenn es zu kompliziert ist, können auch sämtliche Informationen
nach "Abteilung Name (W1)" einfach in diese Zelle "angehängt werden.
Wichtig ist nur, dass der Dateiname (also die Information nach dem letzten /)
auf jeden Fall in eine Zelle geschrieben wird.
Wie kann man diesen Prozess
> per Formel oder per VBA
bewältigen ?
Freu mich sehr auf Tipps und Tricks von Euch
Besten Gruss
Stef@n

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Hyperlink auslesen und aufteilen in Zellen
12.03.2015 17:52:46
Klexy
Zu den Sonderzeichen guckst du hier:
https://www.herber.de/forum/archiv/524to528/526946_Bestimmtes_Zeichen_aus_String_ersetzen.html
Für die einzelnen Elemente, die jeweils nach einem / stehen, musst du in VBA ein Array befüllen und es anschließend wieder auslesen.
Darin bin ich aber nicht so fit, es jetzt mal schnell rauszuhauen.
Per Formel geht es auch. Dazu gab es vor ein paar Tagen hier im Forum eine Lösung.
https://www.herber.de/forum/messages/1414008.html

Anzeige
AW: Hyperlink auslesen und aufteilen in Zellen
12.03.2015 22:16:11
Werner
Hi
Danke für die schnelle Antwort :)
.. gute Links mit guten Hinweisen :)
... wechseln ist sicher eine gute Idee
... der zweite Link kopiert Inhalte nach unten
- ich benötige jedoch "kopieren" EinzelInhalte nach rechts w der SharepointListe
Morgen versuch ich mich
Vielleicht hat noch jemand eine weiter gute Idee :)
BG
Stef@n

AW: Hyperlink auslesen und aufteilen in Zellen
13.03.2015 16:03:25
fcs
Hallo Stef@n,
wenn du schon Makros einsetzt, dann kann das Auflösen des Links auch in einer Sub-Routine erledigt werden. Da kann man auch ohne Probleme den Sonderfall "weitere Unterverzeichnisse" mit erfassen.
Gruß
Franz
Sub Hyperlinks_Aufloesen()
Dim strHypText As String
Dim wks As Worksheet
Dim Zeile As Long, StatusCalc As Long
Set wks = ActiveSheet
'Makrobremsen lösen
With Application
.ScreenUpdating = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
End With
With wks
'Startzeile des Schleifenzählers anpassen !!!
For Zeile = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
strHypText = HyperlinkAdresse(Zelle:=wks.Cells(Zeile, 2))
If strHypText  "" Then
Call AufbereitenHypLinkText(strTextLink:=strHypText, _
ZelleStart:=.Cells(Zeile, 5)) 'Spaltennummer ggf. anpassen
End If
Next Zeile
End With
'Makrobremsen zurücksetzen
With Application
.ScreenUpdating = True
.Calculation = StatusCalc
End With
End Sub
Function HyperlinkAdresse(Zelle As Range) As String
Dim Link As String
Application.Volatile
If Zelle.Hyperlinks.Count Then
Link = Zelle.Hyperlinks(1).Address
End If
HyperlinkAdresse = Link
End Function
Sub AufbereitenHypLinkText(ByVal strTextLink As String, ZelleStart As Range)
'ZelleStart = Zelle, ab der nach rechts die Teile des Hyperlinks eingetragen werden sollen
Dim strLink As String, strZelle As String
Dim arrLink, intK As Integer
strLink = strTextLink
'Ersetzen von Sonderzeichen im Link-Text
'     %2F = /
'     %20 = Leerzeichen
'     %28 = (
'     %29 = )
strLink = VBA.Replace(strLink, "%2F", "/")
strLink = VBA.Replace(strLink, "%20", " ")
strLink = VBA.Replace(strLink, "%28", "(")
strLink = VBA.Replace(strLink, "%29", ")")
'Splitten des Linktextes am "/"
arrLink = Split(strLink, "/")
strZelle = arrLink(0)
For intK = 1 To 4
strZelle = strZelle & "/" & arrLink(intK)
Next
ZelleStart.Value = "'" & strZelle 'Basis-Verzeichnis
ZelleStart.Offset(0, 1).Value = "'" & arrLink(5) 'Team
ZelleStart.Offset(0, 2).Value = "'" & arrLink(6) 'Fortschritt
ZelleStart.Offset(0, 3).Value = "'" & arrLink(7) '1000
ZelleStart.Offset(0, 4).Value = "'" & arrLink(8) 'Bereich
strZelle = arrLink(9)
For intK = 10 To UBound(arrLink) - 1
strZelle = strZelle & "/" & arrLink(intK)
Next
ZelleStart.Offset(0, 5).Value = "'" & strZelle 'Name + anderes
ZelleStart.Offset(0, 6).Value = "'" & arrLink(UBound(arrLink)) 'Dateiname
End Sub

Anzeige
AW: Hyperlink auslesen und aufteilen in Zellen
16.03.2015 09:27:59
Stef@n
Hallo Franz
perfekt :)
jetzt mach ich mich mal ran, noch weitere Sonderzeichen wie
Ä Ö Ü usw zu entfernen
und dann noch die Aufstellung
auf noch weitere "Unterverzeichnisse" zu erweitern.
Dank für Deinen Code :)
.. jetzt lerne ich wieder dazu in VBA ;)
Besten Gruss
Stef@n

AW: Hyperlink auslesen und aufteilen in Zellen
16.03.2015 11:48:06
Stef@n
Hallo Franz,
kannst du nochmal helfen ?
Ich habe das Ersetzen der %... erweitert
Möchte jetzt das mit dem weiteren Unterverzeichnissen erweitern...
kriegs aber nicht gebacken :O ... meine VBA-Kenntnisse sind doch eher rudimentär ;)
Gruss
Stef@n
hier mein Code
Sub Hyperlinks_Aufloesen()
Dim strHypText As String
Dim wks As Worksheet
Dim Zeile As Long, StatusCalc As Long
Set wks = ActiveSheet
'Makrobremsen lösen
With Application
.ScreenUpdating = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
End With
With wks
'Startzeile des Schleifenzählers anpassen !!!
For Zeile = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
strHypText = HyperlinkAdresse(Zelle:=wks.Cells(Zeile, 2))
If strHypText  "" Then
Call AufbereitenHypLinkText(strTextLink:=strHypText, _
ZelleStart:=.Cells(Zeile, 15)) 'J = 10. Spaltennummer ggf.  _
anpassen
End If
Next Zeile
End With
'Makrobremsen zurücksetzen
With Application
.ScreenUpdating = True
.Calculation = StatusCalc
End With
End Sub

Function HyperlinkAdresse(Zelle As Range) As String
Dim Link As String
Application.Volatile
If Zelle.Hyperlinks.Count Then
Link = Zelle.Hyperlinks(1).Address
End If
HyperlinkAdresse = Link
End Function

Sub AufbereitenHypLinkText(ByVal strTextLink As String, ZelleStart As Range)
'ZelleStart = Zelle, ab der nach rechts die Teile des Hyperlinks eingetragen werden sollen
Dim strLink As String, strZelle As String
Dim arrLink, intK As Integer
strLink = strTextLink
'Ersetzen von Sonderzeichen im Link-Text
'     %2F = /
'     %20 = Leerzeichen
'     %28 = (
'     %29 = )
strLink = VBA.Replace(strLink, "%2F", "/")
strLink = VBA.Replace(strLink, "%20", " ")
strLink = VBA.Replace(strLink, "%28", "(")
strLink = VBA.Replace(strLink, "%29", ")")
strLink = VBA.Replace(strLink, "%2C", ",")
strLink = VBA.Replace(strLink, "%C3%B6", "ö")
strLink = VBA.Replace(strLink, "%C3%BC", "ü")
strLink = VBA.Replace(strLink, "%C3%9C", "Ü")
strLink = VBA.Replace(strLink, "%C3%A4", "ä")
strLink = VBA.Replace(strLink, "%2B", "+")
strLink = VBA.Replace(strLink, "%C3%9F", "ß")
strLink = VBA.Replace(strLink, "%C3%84", "Ä")
strLink = VBA.Replace(strLink, "%21", "!")
strLink = VBA.Replace(strLink, "%C2%AD", "")  'weicher Zeilenumbruch ersetzen
'Splitten des Linktextes am "/"
arrLink = Split(strLink, "/")
strZelle = arrLink(0)
For intK = 1 To 5
strZelle = strZelle & "/" & arrLink(intK)
Next
ZelleStart.Value = "'" & strZelle 'Basis-Verzeichnis
ZelleStart.Offset(0, 1).Value = "'" & arrLink(5) 'Team
ZelleStart.Offset(0, 2).Value = "'" & arrLink(6) 'Fortschritt
ZelleStart.Offset(0, 3).Value = "'" & arrLink(7) '1000
ZelleStart.Offset(0, 4).Value = "'" & arrLink(8) 'Bereich
ZelleStart.Offset(0, 5).Value = "'" & arrLink(9)
'    ZelleStart.Offset(0, 6).Value = "'" & arrLink(10)
'    ZelleStart.Offset(0, 7).Value = "'" & arrLink(11)
'    ZelleStart.Offset(0, 8).Value = "'" & arrLink(12)
'    ZelleStart.Offset(0, 9).Value = "'" & arrLink(13)
'    ZelleStart.Offset(0, 10).Value = "'" & arrLink(14)
'              ZelleStart.Offset(0, 11).Value = "'" & arrLink(15)
strZelle = arrLink(9)
For intK = 10 To UBound(arrLink) - 1
strZelle = strZelle & "/" & arrLink(intK)
Next
ZelleStart.Offset(0, 6).Value = "'" & strZelle 'Name + anderes
ZelleStart.Offset(0, 7).Value = "'" & arrLink(UBound(arrLink)) 'Dateiname
End Sub

Anzeige
AW: Hyperlink auslesen und aufteilen in Zellen
16.03.2015 13:40:19
fcs
Hallo Stef@n,
ich würde es so lösen, dass die Teile di in jedem Link vorkommen und der Dateiname in den ersten Spalten stehn. Nach dem Dateinamen dann die Restlichen Unterverzeichnisse zum Namen.
Wenn du weiss wieviele zusätzliche Unterverzeichnisse es maximal gibt, dann kannst den Dateinamen auch in eine Spalte entsprechend weit rechts eintragen.
Gruß
Franz
Sub AufbereitenHypLinkText(ByVal strTextLink As String, ZelleStart As Range)
'ZelleStart = Zelle, ab der nach rechts die Teile des Hyperlinks eingetragen werden sollen
Dim strLink As String, strZelle As String
Dim arrLink, intK As Integer
strLink = strTextLink
'Ersetzen von Sonderzeichen im Link-Text
'     %2F = /
'     %20 = Leerzeichen
'     %28 = (
'     %29 = )
strLink = VBA.Replace(strLink, "%2F", "/")
strLink = VBA.Replace(strLink, "%20", " ")
strLink = VBA.Replace(strLink, "%28", "(")
strLink = VBA.Replace(strLink, "%29", ")")
strLink = VBA.Replace(strLink, "%2C", ",")
strLink = VBA.Replace(strLink, "%C3%B6", "ö")
strLink = VBA.Replace(strLink, "%C3%BC", "ü")
strLink = VBA.Replace(strLink, "%C3%9C", "Ü")
strLink = VBA.Replace(strLink, "%C3%A4", "ä")
strLink = VBA.Replace(strLink, "%2B", "+")
strLink = VBA.Replace(strLink, "%C3%9F", "ß")
strLink = VBA.Replace(strLink, "%C3%84", "Ä")
strLink = VBA.Replace(strLink, "%21", "!")
strLink = VBA.Replace(strLink, "%C2%AD", "")  'weicher Zeilenumbruch ersetzen
'Splitten des Linktextes am "/"
arrLink = Split(strLink, "/")
strZelle = arrLink(0)
For intK = 1 To 5
strZelle = strZelle & "/" & arrLink(intK)
Next
ZelleStart.Value = "'" & strZelle 'Basis-Verzeichnis
ZelleStart.Offset(0, 1).Value = "'" & arrLink(5) 'Team
ZelleStart.Offset(0, 2).Value = "'" & arrLink(6) 'Fortschritt
ZelleStart.Offset(0, 3).Value = "'" & arrLink(7) '1000
ZelleStart.Offset(0, 4).Value = "'" & arrLink(8) 'Bereich
ZelleStart.Offset(0, 5).Value = "'" & arrLink(9) 'Name
ZelleStart.Offset(0, 6).Value = "'" & arrLink(UBound(arrLink)) 'Dateiname
'restliche Unterverzeichnis in einzelne Zellen schreiben
For intK = 10 To UBound(arrLink) - 1
ZelleStart.Offset(0, 7 + intK - 10).Value = "'" & arrLink(intK) 'weitere UV
Next
End Sub

Anzeige
AW: Hyperlink auslesen und aufteilen in Zellen
16.03.2015 14:44:46
Stef@n
Hallo Franz,
bin beeindruckt :) läuft perfekt - egal, wieviel "Unterverzeichnisse vorhanden sind.
In die 7. Spalte wird der DateiName eingetragen - und falls noch mehr "Unterverz" vorhanden
sind, werden diese ab der 8. Spalte befüllt
Jetzt doch noch eine Idee:
am besten sollte der Dateiname in der ersten Spalte und erst danach die ganzen Verzeichnisse ...
Wäre das möglich ?
Freu mich auf einen weiteren Tip von Dir :)
Besten Gruss
Stef@n

AW: Hyperlink auslesen und aufteilen in Zellen
16.03.2015 17:14:07
fcs
Hallo Stefan,
dan vereinfacht sich der 2. Teile des Makros wie folgt.
Gruß
Franz
  'Splitten des Linktextes am "/"
arrLink = Split(strLink, "/")
ZelleStart.Value = "'" & arrLink(UBound(arrLink)) 'Dateiname
'Felder 0 bis 4 des Arrays wieder zu einem Text zusammenbauen als Basis-Verzeichnis
strZelle = arrLink(0)
For intK = 1 To 4
strZelle = strZelle & "/" & arrLink(intK)
Next
ZelleStart.Offset(0, 1).Value = "'" & strZelle 'Basis-Verzeichnis
'restliche Unterverzeichnisse in einzelne Zellen schreiben
For intK = 5 To UBound(arrLink) - 1
ZelleStart.Offset(0, 2 + intK - 5).Value = "'" & arrLink(intK) 'weitere UV
Next
End Sub

Anzeige
AW: Hyperlink auslesen und aufteilen in Zellen
17.03.2015 09:43:10
Stef@n
Moin Franz,
DAUMEN HOCH !
Klasse !
Jetzt kann ich Inhaltsverzeichnisse von Sharepoint-Bibliotheken erstellen
und diese in Pivot auswerten :)))
Freu
Stef@n

312 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige