Microsoft Excel

Herbers Excel/VBA-Archiv

Bewerten Sie hier bitte das Excel-Portal

Der kurze Weg zum Ziel: Auftragsprogrammierung

Frage an Herrn Herber !

Betrifft: Frage an Herrn Herber ! von: Klamsi
Geschrieben am: 17.08.2004 09:39:16

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 :)
  


Betrifft: AW: Frage an Herrn Herber ! von: Hans W. Herber
Geschrieben am: 17.08.2004 09:48:39

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


 

Beiträge aus den Excel-Beispielen zum Thema "Frage an Herrn Herber !"

Suche im Internet in Herbers Excel-Archiv