使用 VBA 导入时，超过 100,000 的数据集上的行消失

Question

我在 Excel 2010 年使用了一个宏来遍历一些 xls 文件，将每个文件中的数据提取到一个 xlsm 文件中。所有 xls 文件中应该有大约 195,000 行，但在运行处理它之后，我最终得到接近 90,000 行。如果我运行它一次只在几个文件上我得到正确的数字所以它似乎与我试图合并的卷有关，但我知道 xlsm 最多可以处理一百万行，所以这应该不是问题，不是吗？我过去曾将源文件分成几批，但如果可能的话，我宁愿避免这样做。最终，我试图编译一个 csv 以导入到 SQL 数据库中。如果有人有任何建议，我将不胜感激。

谢谢。

PS 我大约一个月前问过这个问题，但由于我完全误诊了这个问题并且问错了问题，我正在写一个新问题，这样我就不会让人误入歧途。上次我因为没有包含足够的代码而受到了正确的惩罚。这是提取数据的子程序：

Sub import_data()

Dim wk As Workbook
Dim shRead As Worksheet, ws As Worksheet
Dim i As Integer
Dim reportLocation As String
Dim report As String
Dim reportList As String
Dim reportArray() As String
Dim shReadLastColumn As Long
Dim shReadLastRow As Long


'generate list of xls to open
reportLocation = "C:\Foo"
report = Dir(reportLocation & "\*.xls")
reportList = ""

Do While Len(report) > 0
    reportList = report & "," & reportList
    report = Dir
Loop

reportArray() = Split(reportList, ",")

'loop through list of xls files
For i = UBound(reportArray) To LBound(reportArray) Step -1

    If reportArray(i) <> "" Then
        
        Set wk = Workbooks.Open(reportLocation & "\" & reportArray(i), ReadOnly:=True)
        Set shRead = wk.Worksheets(1)
        
    
        With shRead
            shReadLastColumn = .Cells(10, shRead.Columns.count).End(xlToLeft).Column
            shReadLastRow = .Cells(shRead.Rows.count, "A").End(xlUp).Row
        End With
   
        'copy list over on to xlsm compilation
        Dim target_row As Long
        Set ws = ThisWorkbook.Worksheets(1)
        If IsEmpty(ws.Cells(1, 1)) Then
            target_row = 1
            shRead.Range(shRead.Cells(10, 1), shRead.Cells(shReadLastRow, shReadLastColumn)).Copy ws.Cells(target_row, 1)
            Else
            target_row = ws.Cells(Rows.count, 1).End(xlUp).Row + 1
            shRead.Range(shRead.Cells(10 + 1, 1), shRead.Cells(shReadLastRow, shReadLastColumn)).Copy ws.Cells(target_row, 1)
        End If

        wk.Activate
        ActiveWorkbook.Close False
    
    End If

    Set wk = Nothing
    Set shRead = Nothing

Next i

结束子

感谢您的帮助！

Answer 1

您似乎有一个不合格的引用，缺少 target_row 的工作簿对象：

target_row = ws.Cells(Rows.count, 1).End(xlUp).Row + 1

应该是

target_row = ws.Cells(ws.Rows.count, 1).End(xlUp).Row + 1

此外，考虑使用 With 块并避免任何 Activate 或 ActiveWorkbook 调用：

' WITH BLOCK (no use of ws)
With ThisWorkbook.Worksheets(1)
    If IsEmpty(.Cells(1, 1)) Then
        target_row = 1
        shRead.Range(shRead.Cells(10, 1), shRead.Cells(shReadLastRow, shReadLastColumn)).Copy .Cells(target_row, 1)
    Else
        target_row = .Cells(.Rows.count, 1).End(xlUp).Row + 1
        shRead.Range(shRead.Cells(10 + 1, 1), shRead.Cells(shReadLastRow, shReadLastColumn)).Copy .Cells(target_row, 1)
    End If
End With

' ADJUSTED LINE
wk.Close False

此外，如果您只需要没有格式的数据，请考虑范围分配：

With ThisWorkbook.Worksheets(1)
    ...
    target_row = .Cells(.Rows.count, 1).End(xlUp).Row + 1
    .Cells(target_row, target_row + shReadLastRow - 11).Value = shRead.Range( _
        shRead.Cells(10 + 1, 1), shRead.Cells(shReadLastRow, shReadLastColumn) _
    )
    ...
End With

使用 VBA 导入时，超过 100,000 的数据集上的行消失

rows disappearing on datasets of over 100,000 when importing with VBA

csv

excel

vba

xls

xlsm