0

我正在寻找有关 VBA 的帮助，以Column A从文件夹中查找 excel 中列出的文件名并返回文件路径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
4

1 回答 1

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 & ".*"
于 2013-10-14T05:54:11.903 回答