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

这是我一直试图通过在代码中添加另一个IF语句来修改的功能-不成功：

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

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

1 个答案: