Question

我正在寻找VBA的帮助，以便从文件夹中查找excel Column A中列出的文件名，并返回Column B

中的文件路径

下面的代码可行，但如果我想excel跳过行，如果找不到文件名，那么文件路径结果将直接返回到文件名旁边的单元格中。

Private Sub CommandButton1_Click()
        Dim sh As Worksheet, rng As Range, lr As Long, fPath As String
        Set sh = Sheets(1) 'Change to actual
       lstRw = sh.Cells.Find(What:="*", After:=sh.Range("A1"), LookAt:=xlWhole, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
        Set rng = sh.Range("A2:A" & lstRw)
        With Application.FileDialog(msoFileDialogFolderPicker)
            .Show
            fPath = .SelectedItems(1)
        End With
        If Right(fPath, 1) <> "\" Then
            fPath = fPath & "\"
        End If
        fwb = Dir(fPath & "*.*")
        x = 2
        Do While fwb <> ""
            For Each c In rng
                If InStr(LCase(fwb), LCase(c.Value)) > 0 Then
                    Worksheets("Sheet2").Range("A" & x) = fwb
                    Set fs = CreateObject("Scripting.FileSystemObject")

                    Set f = fs.GetFile(fPath & fwb)
                    Worksheets("Sheet1").Range("B" & x) = f.Path


                    Set fs = Nothing
                    Set f = Nothing
                    x = x + 1


                End If
            Next
            fwb = Dir
        Loop
        Set sh = Nothing
        Set rng = Nothing
        Sheets(2).Activate

End Sub

Answer 1

正如我在上面的评论中所提到的，在范围循环中使用DIR。见这个例子。

如果Col A中的相应单元格没有返回任何内容，它将不会向Col B输出任何内容。

Sub Sample()
    Dim sh As Worksheet
    Dim rng As Range
    Dim i As Long, Lrow As Long
    Dim fPath As String, sPath As String

    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show
        fPath = .SelectedItems(1)
    End With

    If Right(fPath, 1) <> "\" Then
        fPath = fPath & "\"
    End If

    Set sh = ThisWorkbook.Sheets("Sheet1")

    With sh
        Lrow = .Range("A" & .Rows.Count).End(xlUp).Row

        For i = 2 To Lrow
            '~~> Check for partial match
            sPath = fPath & "*" & .Range("A" & i).Value & "*.*"

            If Len(Trim(Dir(sPath))) > 0 Then
                .Range("B" & i).Value = Dir(sPath)
            End If
        Next i
    End With
End Sub

注意：如果您不想部分匹配，请考虑修改

sPath = fPath & "*" & .Range("A" & i).Value & "*.*"

到

sPath = fPath & .Range("A" & i).Value & ".*"

Excel VBA文件名搜索返回路径

1 个答案: