Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
468to472
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
468to472
468to472
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Frage an Herrn Herber !

Frage an Herrn Herber !
17.08.2004 09:39:16
Klamsi
Hi!
Ich habe mal wieder ne Frage, diesmal speziell an dich:
Du hattest mir gestern diesen Quellcode gegeben:

Sub PfadFiltern()
Dim wksA As Worksheet, wksB As Worksheet
Dim vRow As Variant
Dim iRow As Integer, iChar As Integer
Dim sPath As String
Set wksA = Worksheets("Sheet2")
Set wksB = Worksheets("Sheet3")
iRow = 2
Do Until IsEmpty(wksB.Cells(iRow, 1))
vRow = Application.Match("*" & wksB.Cells(iRow, 1).Value, wksA.Columns(1), 0)
If Not IsError(vRow) Then
sPath = wksA.Cells(vRow, 1).Value
For iChar = Len(sPath) To 1 Step -1
If Mid(sPath, iChar, 1) = "\" Then Exit For
Next iChar
wksB.Cells(iRow, 2).Value = Left(sPath, iChar - 1)
End If
iRow = iRow + 1
Loop
End Sub

----------
Der Funktioniert eigentlich wunderbar, nur gibts ein kleines Problem:
Unter dieser URL liegt nochmal die Datei dazu:
https://www.herber.de/bbs/user/9677.xls
Und zwar habe ich in meiner Liste auch Dateinamen mit Sonderzeichen, in meinem Fall speziell das "~" - Zeichen. Enthält ein Filename dieses Zeichen, wird der Pfad leider nicht mit übernommen. Hast du eine Lösung dazu?
Danke schon mal im Vorraus :)

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Frage an Herrn Herber !
17.08.2004 09:48:39
Hans
Hallo,
die Tilde stellt einen Sonderfall dar und muss mit einer zweiten Tilde maskiert werden:

Sub PfadFiltern()
Dim wksA As Worksheet, wksB As Worksheet
Dim vRow As Variant
Dim iRow As Integer, iChar As Integer
Dim sPath As String, sFile As String
Set wksA = Worksheets("Sheet2")
Set wksB = Worksheets("Sheet3")
iRow = 2
Do Until IsEmpty(wksB.Cells(iRow, 1))
sFile = wksB.Cells(iRow, 1).Value
sFile = WorksheetFunction.Substitute(sFile, "~", "~~")
vRow = Application.Match("*" & sFile, wksA.Columns(1), 0)
If Not IsError(vRow) Then
sPath = wksA.Cells(vRow, 1).Value
For iChar = Len(sPath) To 1 Step -1
If Mid(sPath, iChar, 1) = "\" Then Exit For
Next iChar
wksB.Cells(iRow, 2).Value = Left(sPath, iChar - 1)
End If
iRow = iRow + 1
Loop
End Sub

gruss hans
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige