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

Linken Text löschen, vor rechten Backsslash

Linken Text löschen, vor rechten Backsslash
05.04.2019 16:33:38
Dieter(Drummer)
Guten Tag VBA Spezislisten.
VBA Lösung für folgendes Problem gesucht:
Grundsätzlich geht es nur um Spalte C, in "Tabelle1"
Die Hyperlinks beinhalten Text mit mehreren Backslashs.
Suche nun einen Code, der nur in Zellen, in denen Hyperlinks sind,
der den linken Textteil löscht, vor dem rechts gefundenen, ersten Backslash.
z.B. Spalte C:
C:\OrderX\xDivers1\Xdivers2\DateiXY.xlsm
Ergebnis: DateiXY.xlsm
Das jeweilige Ergebnis soll weiter als Hyperlink existieren.
Meine Suche im Netz brachte mich nicht weiter.
Mit der Bitte um Hilfe, grüßt
Dieter(Drummer)

27
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Linken Text löschen, vor rechten Backsslash
05.04.2019 16:46:20
Daniel
Hi
Sub Makro1()
Dim Zelle As Range
For Each Zelle In Columns(3).SpecialCells(xlCellTypeConstants)
If Zelle.Hyperlinks.Count = 1 Then
With Zelle.Hyperlinks(1)
.TextToDisplay = Mid(.Address, InStrRev(.Address, "\") + 1)
End With
End If
Next
End Sub
Gruß Daniel
AW: Linken Text löschen, vor rechten Backsslash
05.04.2019 16:53:11
Dieter(Drummer)
Danke Daniel,
für deine perfekte und schnelle Lösung.
Meine Versuche waren einfach nur Murks :-)
Gruß und ein erfeuliches Wochenende,
Dieter(Drummer)
AW: Linken Text löschen, vor rechten Backsslash
05.04.2019 17:19:29
Dieter(Drummer)
Hallo Daniel,
habe dein Makro jetzt in Originaldatei getestet und es bleibt noch der rechte Backslash und ein linker Teilrest stehen.
Beispiel:
../Buttons/Alle_Buttons_JPGs.xlsm
Es sollte nur Alle_Buttons_JPGs.xlsm stehen bleiben.
Geht das aucxh noch per Code raus?
Gruß, Dieter(Drummer)
Anzeige
/\?
05.04.2019 17:23:12
Daniel
da steht bei dir kein Backslash, sondern der normale Slash (der auf der 7)
dann musst du den Verwenden.
probier mal meine andere Lösung, vielleicht ist die für dich einfacher nachvolliebar (geht auch ohne Code).
Gruß Daniel
AW: Siehe meine letzte Meldung an dich ...
05.04.2019 17:26:10
Dieter(Drummer)
... die jetzt prima funktioniert.
Gruß, Dieter(Drummer)
Benutze InstrRev...
05.04.2019 16:49:18
Beverly
Hi Dieter,
...siege hier: https://docs.microsoft.com/de-de/office/vba/language/reference/user-interface-help/instrrev-function
Wenn das ganze als Hyperlink weiter funktionieren soll, darfst du nur den Anzeigetext ändern und nicht den Link selbst.


Anzeige
AW: Benutze InstrRev...
05.04.2019 16:58:11
Dieter(Drummer)
Danke Karin,
werde mir den Link zu Gemüte führen.
Functionen, die nicht ganz das waren, was ich suchte, hatte ich auch schon im Netz gefunden, aber es sollte keine Function sein.
Gruß und einen erfreilichen Resttag,
Dieter(Drummer)
InstrRev...
05.04.2019 17:44:31
Beverly
Hu Dieter,
...ist doch genau die Function, die Daniel in seinem Code benutzt...


AW: Hallo Katrin, Danke für Hinweis ...
05.04.2019 18:15:47
Dieter(Drummer
... nichts für Ungut ... ich dachte du meintest eine Function, die ich als Formel nutze.
Ich bin nicht der VBA annähernde Könner. Dank an alle, die etwas Nachsicht haben ...
Ich versuche besser zu werden ...
Gruß, Dieter(Drummer)
Anzeige
Noch ein Hinweis ...
05.04.2019 18:29:56
Beverly
...am Rande: mein Name ist nicht Katrin.


AW: Sorry Karin! Gruß owT
05.04.2019 18:38:38
Dieter(Drummer)
in dem Fall gehts noch einfacher
05.04.2019 17:12:22
Daniel
Ersetze mit der Ersetzenfunktion "*\" durch nichts.
Bei bestehendem Hyperlink wirkt das Ersetzen nur auf den angezeiten Text, aber nicht auf die Linkadresse.
geht auch mit VBA:
Columns(3).replace "*\", "", xlpart
Gruß Daniel
AW: in dem Fall gehts noch einfacher
05.04.2019 17:24:19
Dieter(Drummer)
Hallo Daniel,
habe deinen Code jetzt so angepasst, nach deiner Vorgabe und es funktioniert jetzt perfekt,
Danke und Gruß,
Dieter(Drummer)
Der jetzige Code:
'Herber: von Daniel am 05.04.2019 16:46:20
Sub Textteil_raus()
Dim Zelle As Range
MsgBox "Der linke Text, vor dem ersten," & vbLf & "rechten Backslash,wird gelöscht." & vbLf & " _
Der Hyperlink bleibt erhalten." 'Mx 05.04.2019
For Each Zelle In Columns(3).SpecialCells(xlCellTypeConstants)
If Zelle.Hyperlinks.Count = 1 Then
With Zelle.Hyperlinks(1)
Columns(3).Replace "*\", "", xlPart
End With
End If
Next
End Sub

Anzeige
AW: in dem Fall gehts noch einfacher
05.04.2019 17:37:06
Daniel
Hi
naja, so mitdenken tust du beim Programmieren nicht.
warum verwendest du die Schleife über jede einzelne Zelle, wenn du dann das Ersetzen sowieso für die ganze Spalte ausführst?
das das was du machst Unsinn ist, erkennst du auch daran, dass du innerhalb der WITH-Klammer niemals den Punkt einsetzt und somit deine WITH-Klammer unnötig und überflüssig ist.
Gruß Daniel
AW: Danke für erneuten Hinweis, Daniel ...
05.04.2019 18:08:45
Dieter(Drummer)
... ich zähle nicht zu den VBA annähernden Könnern und es ist für mich nicht so einfach.
Danke für deine Hilfe und Hinweise. Den Code habe ich jetzt so geändert und er funktioniert ...
Gruß, Dieter(Drummer)
Jetziger Code:
'Herber: von Daniel am 05.04.2019 16:46:20
Sub Textteil_raus()
Dim Zelle As Range
Application.ScreenUpdating = False
MsgBox "Der linke Text, vor dem ersten," & vbLf & "rechten Backslash,wird gelöscht." & vbLf & " _
Der Hyperlink bleibt erhalten." & vbLf & vbLf & "Bitte warten ..." 'Mx 05.04.2019
For Each Zelle In Columns(3).SpecialCells(xlCellTypeConstants)
If Zelle.Hyperlinks.Count = 1 Then
Columns(3).Replace "*\", "", xlPart
End If
Next
End Sub

Anzeige
AW: Änderung erst ab Zeile 13
07.04.2019 09:45:59
Dieter(Drummer)
Guten Morgen Daniel,
auf die Gefahr hin, dass ich nerve, habe ich noch eine Bitte.
Der Code von dir sollte so sein, dass erst ab Spalte 3, ab inkl. Zeile 13 beginnt.
Meine Änderungversuche brachten keinen Erfolg.
Mit der Bitte nochmal um deine Hilfe,
grüßt Dieter(Drummer)
Dein bisheriger, prima funktionierender Code:
'Herber: von Daniel am 05.04.2019 16:46:20
Sub Textteil_raus()
Dim Zelle As Range
Application.ScreenUpdating = False
MsgBox "Der linke Text, vor dem ersten," & vbLf & "rechten Backslash,wird gelöscht." & vbLf & " _
Der Hyperlink bleibt erhalten." & vbLf & vbLf & "Bitte warten ..." 'Mx 05.04.2019
For Each Zelle In Columns(3).SpecialCells(xlCellTypeConstants)
If Zelle.Hyperlinks.Count = 1 Then
With Zelle.Hyperlinks(1)
Columns(3).Replace "*\", "", xlPart
End With
End If
Next
End Sub

Anzeige
If Zelle.Row > 12 Then ...
07.04.2019 10:09:53
Matthias
Hallo Dieter
dann probiers so ...
For Each Zelle In Columns(3).SpecialCells(xlCellTypeConstants)
If Zelle.Row > 12 Then
If Zelle.Hyperlinks.Count = 1 Then
With Zelle.Hyperlinks(1)
Columns(3).Replace "*\", "", xlPart
End With
End If
End If
Next
Gruß Matthias
AW: If Zelle.Row > 12 Then ...
07.04.2019 10:31:12
Dieter(Drummer)
Hallo Mattias,
danke für deine Rückmeldung. Es wird trotz deiner Änderung/Ergänzung, NICHT erst ab Zeile 13 begonnen, sondern weiter direkt an Zeile1.
Gruß, Dieter(Drummer)
Hier der derzeitige Code mit deiner Anpassung:
'Herber: von Daniel am 05.04.2019 16:46:20
Sub Textteil_raus()
Dim Zelle As Range
Application.ScreenUpdating = False
MsgBox "Der linke Text, vor dem ersten," & vbLf & "rechten Backslash,wird gelöscht." & vbLf & " _
Der Hyperlink bleibt erhalten." & vbLf & vbLf & "Bitte warten ..." 'Mx 05.04.2019
For Each Zelle In Columns(3).SpecialCells(xlCellTypeConstants)
If Zelle.Row > 12 Then 'Herber: Matthias am 07.04,2019
If Zelle.Hyperlinks.Count = 1 Then
With Zelle.Hyperlinks(1)
Columns(3).Replace "*\", "", xlPart
End With
End If
End If 'Herber: Matthias am 07.04,2019
Next
End Sub

Anzeige
hab jetzt erst alles gelesen ...
07.04.2019 10:50:04
Matthias
Hallo
hab jetzt erst alles gelesen ...
Wie Daniel bereits erwähnte programmierst Du das With-Konstrukt und benutzt es aber nicht.
Dann nimm Daniels 1.Vorschlag und setze das
If Zelle.Row > 12 Then und das End If an die richtige Stelle.
Gruß Matthias
AW: Geht noch nicht ...
07.04.2019 11:15:48
Dieter(Drummer)
Hallo Matthias,
habe es jetzt so umgesetzt, wie du angegeben hast. Es wird aber immer noch ab Zeile1 der Textteil gelöscht. Wäre schön, wenn du da noch eine Idee hast.
Gruß, Dieter(Drummer)
Hier meine jetzige Version mit ersten Code von Daniel und deine Anpassung:
https://www.herber.de/bbs/user/128990.xlsm
Anzeige
Columns(3).Replace "*\", "", xlPart ?
07.04.2019 11:28:53
robert
AW: Columns(3).Replace "*\", "", xlPart ?
07.04.2019 11:46:20
Dieter(Drummer)
Danke für Hinweis robert.
Aber was ich da hätte ändern müssen, darauf bin ich nicht gekommen und Matthias hatte mir die effektive Lösung gegeben.
Gruß, Dieter(Drummer)
AW: Geht noch nicht ... logisch!
07.04.2019 11:33:22
Matthias
Hallo
Option Explicit
Sub Textteil_raus()
Dim Zelle As Range
For Each Zelle In Columns(3).SpecialCells(xlCellTypeConstants)
With Zelle
If .Row > 12 Then
If .Hyperlinks.Count = 1 Then
.Replace "*\", "", xlPart
End If
End If
End With
Next
End Sub
Gruß Matthias
AW: Danke Matthias, es funktioniert ...
07.04.2019 11:44:02
Dieter(Drummer)
... nun klappt es wie gewünscht.
Hatte mir gedacht, dass es an der Zeile hängt: ".Replace "*\", "", xlPart". Aber da wäre ich nicht drauf gekommen.
Danke und Gruß,
Dieter(Drummer)
Anzeige
If .Hyperlinks.Count = 1 ist auch nicht nötig ...
07.04.2019 11:47:25
Matthias
Hallo Dieter
Eigentlich reicht das auch schon:
Option Explicit
Sub Textteil_raus()
Dim Zelle As Range
For Each Zelle In Columns(3).SpecialCells(xlCellTypeConstants)
With Zelle
If .Row > 12 Then
.Replace "*\", "", xlPart
End If
End With
Next
End Sub
Gruß Matthias
Korrektur, lass es drin :-)
07.04.2019 12:00:21
Matthias
Hatte übersehen das es nur auf die Hyperlinks angewendet werden soll.
Dim Zelle As Range
For Each Zelle In Columns(3).SpecialCells(xlCellTypeConstants)
With Zelle
If .Row > 12 Then
If Zelle.Hyperlinks.Count = 1 Then .Replace "*\", "", xlPart
End If
End With
Next
Gruß Matthias
AW: Danke Matthias, ich lass es drin ...
07.04.2019 12:07:09
Dieter(Drummer)
... und es furnktionuert perfekt und ist bei 1.800 Hypers in Spalte 3, blitz schnell.
Gruß, Dieter(Drummer)

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige