Question

我想循环浏览文件夹和子文件夹。它适用于我的代码。我的下一步是检查 - 如果第4列中指定的单元格不为空（在子文件夹中的每个文件中），则将文件中的值复制到我的主文件（例如ActiveWorkbook.ActiveSheet） - 追加。在每次尝试中我都遇到问题，现在它是“对象变量或未设置块变量”。但是做套装会产生新的错误。有人可以帮忙吗？此致

Sub DoFolder()

Dim fso, oFolder, oSubfolder, oFile, queue As Collection
Dim FileName As String
Dim PathName As String
Dim Wb As Workbook
Dim newbook As Worksheet
Dim i As Integer
Dim lastRow As Long
Dim col As Range, coll As Range
Dim someRange As Range


Set fso = CreateObject("Scripting.FileSystemObject")
Set queue = New Collection
queue.Add fso.GetFolder("Y:\MDM\__ZADANIA\LISTOWANIE\Archiwum\") 'obviously replace


Application.ScreenUpdating = False


'Nagłówki do nowego pliku z danymi
Set newbook = ActiveWorkbook.ActiveSheet
With newbook
    .Columns("A").Cells(1, 1) = "Subsystem"
    .Columns("B").Cells(1, 1) = "MGB"
    .Columns("C").Cells(1, 1) = "EAN Zakupowy"
    .Columns("D").Cells(1, 1) = "Liczba jednostek sprzedaży w kartonie"
    .Columns("E").Cells(1, 1) = "Ilość sztuk w jednostce sprzedaży"
    .Columns("F").Cells(1, 1) = "Nazwa pliku"
    .Columns("G").Cells(1, 1) = "Katalog pliku"
End With

'Fitowanie kolumn
With newbook.Columns("A:G")
    .AutoFit
End With


'zczytywanie ifnormacji z formatek po foldrach i dodawanie do istniejącego pliku
Do While queue.Count > 0
    Set oFolder = queue(1)
    queue.Remove 1
    For Each oSubfolder In oFolder.SubFolders
        queue.Add oSubfolder
    Next oSubfolder
    For Each oFile In oFolder.Files
        Set Wb = Nothing
        Set Wb = Workbooks.Open(oFile)
        Wb.Windows(1).Visible = False
        For i = 15 To 515
            Set someRange = newbook.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
            If Not someRange Is Nothing Then
               lastRow = someRange.Row
            Else
                lastRow = 1
            End If
            If Wb.Sheets("Dane_Dostawcy").Cells(i, 4) <> "" Then
                newbook.Cells(lastRow + 1, 1).Value = Wb.Sheets("Dane_Dostawcy").Cells(i, 4).Value
                newbook.Cells(lastRow + 1, 2).Value = Wb.Sheets("Dane_Dostawcy").Cells(i, 4).Value
                newbook.Cells(lastRow + 1, 3).Value = Wb.Sheets("Dane_Dostawcy").Cells(i, 30).Value
                newbook.Cells(lastRow + 1, 4).Value = Wb.Sheets("Dane_Dostawcy").Cells(i, 56).Value
                newbook.Cells(lastRow + 1, 5).Value = Wb.Sheets("Dane_Dostawcy").Cells(i, 14).Value
                newbook.Cells(lastRow + 1, 6).Value = Wb.Sheets("Dane_Dostawcy").Cells(i, 4).Value
                newbook.Cells(lastRow + 1, 7).Value = Wb.Sheets("Dane_Dostawcy").Cells(i, 4).Value
            Else
                GoTo MyStatement
             End If
MyStatement:
         Next i
     Next oFile
Loop

Application.ScreenUpdating = True
End Sub

Answer 1

它产生了一个错误，因为它找不到任何东西，而你要求.Row的任何东西。

这是一种解决方法：

Dim someRange As Range
Set someRange = newbook.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
If Not someRange Is Nothing Then
    lastRow = someRange.Row
Else
    lastRow = 1
End If

因此，只有在找到某些内容时，它才会将行值赋予lastRow。根据您的业务逻辑，如果它没有找到任何内容，那么该行可能是第一行。

错误的第二个选项（感谢@QHarr） - 您必须声明dim lastRow as Long而不是范围。

循环文件夹 - 将数据从文件复制到主文件

1 个答案: