VBA循环浏览具有特定文件名的文件夹中的文件

Question

我已经设法将这段代码慢慢地开发成可用但还不完全可用的东西。我是 VBA 新手，到目前为止，下面的代码执行以下操作：

• 循环浏览文件夹中的工作簿
• 从每个工作簿复制某些单元格
• 将这些单元格粘贴到具有按列组织的信息的行中
• 从每个工作簿复制一个范围

• 将范围（14 行数据）粘贴到由每个工作簿中的单个单元格形成的单行数据旁边（有效地在工作表中创建两半 - 每一行数据属于某个工作簿（A:E 列）和另一半，每个范围的 14 行属于某个工作簿（F:M 列））

• 只有在文件夹中的工作簿还没有被循环（这是通过函数完成的）时才执行上述所有操作

  • 此函数查看由先前运行代码创建的文件名列 - 这意味着每个循环工作簿的文件名记录在代码创建的列表中，并且代码仅从文件名为的工作簿复制数据尚未包含在列表中。

---

我一直在处理并且需要帮助的代码的下一个开发是添加另一个条件 - 即使代码只查看以前没有循环过的文件，也只查看具有特定条件的文件文件名结尾，在一组未循环的工作簿中。

我如何实现这一点的逻辑是添加另一个函数，就像循环函数一样，并修改其中的代码以查看在单元格中输入的名称的前三个字符，然后将其与非已循环的文件名（文件名结尾（其最后 3 个字符）始终是名称的前三个字符）。

这是主要代码和功能：

Sub CopyFromFolderExample()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets(1)
Dim strFolder As String, strFile As String, r As Long, wb As Workbook
Dim varTemp(1 To 5) As Variant, r1 As Long, r3 As Range

Application.ScreenUpdating = False
strFolder = "D:\Other\folder\"
strFile = Dir(strFolder & "*.xl*")

Do While Len(strFile) > 0
    If Not Looped(strFile, ws) Then
        Application.StatusBar = "Reading data from " & strFile & "..."
        Set wb = Workbooks.Add(strFolder & strFile)
        With wb.Worksheets(1)
            varTemp(1) = strFile
            varTemp(2) = .Range("A13").Value
            varTemp(3) = .Range("H8").Value
            varTemp(4) = .Range("H9").Value
            varTemp(5) = .Range("H37").Value
            Set r3 = .Range("A20:H33")
        End With
        With ws
            r = .Range("A" & .Rows.Count).End(xlUp).Row + 1
            r1 = .Range("F" & .Rows.Count).End(xlUp).Row + 1 'last used row in col F
            .Range(.Cells(r, 1), .Cells(r, 5)).Value = varTemp
            .Cells(r1, 6).Resize(r3.Rows.Count, r3.Columns.Count).Value = r3.Value 'transfer A20:H33
        End With
        wb.Close False
    End If
  strFile = Dir
Loop

Application.StatusBar = False
Application.ScreenUpdating = True

End Sub

---

Private Function Looped(strFile As String, ws As Worksheet) As Boolean

    Dim Found As Range
    Set Found = ws.Range("A:A").Find(strFile)

    If Found Is Nothing Then
        Looped = False
    Else
        Looped = True
    End If

    End Function

这是我一直在尝试通过在代码中添加另一个IFstatement 来使用的修改后的函数 - 未成功：

Private Function notx(strFile As String, ws As Worksheet) As Boolean

Dim Found As Range
Set Found = strFile.Find(Left(ws.Range("P1").Value, 3))

If Found Is Nothing Then
    notx = False
Else
    notx = True
End If

End Function

Answer 1

您的strFile 是一个字符串，您不能在字符串中使用.Find。尝试将您的 notx 函数更改为：

Private Function notx(strFile As String, ws As Worksheet) As Boolean

Dim Found As Integer
Found = InStr(1, strFile, Left(ws.Range("P1").Value, 3))

If Found = 0 Then
    notx = False
Else
    notx = True
End If

End Function