新年快乐！

我的代码有奇怪的行为。

我要查询三个工作簿，每个工作簿都有三张工作表，然后将它们与整理后的三张工作表整理到一个工作簿中。

它可以正常运行；但是，经常会有丢失的细胞。

我做了一些研究，有人说当您使用旧的连接字符串时会发生这种情况。我不是。其他人说，当char长度超过255时会发生这种情况。丢失的单元格是整数的长度6或双精度的长度8。其他人则说这种情况发生在查询有65,535行以上的数据时。我的每个查询最多有3,000行。

我在原始工作表中有一列重复的相同数据，并且重复项缺少与第一列不同的行。

在每个结果表的总共6000行中，第一张表的主列中只有26个零星的单元格为空白；重复列中没有丢失。第二张工作表的主列中没有丢失任何单元格，但是重复的列中有大块丢失的单元格，总计约有500个单元格。第三张纸未变。

作为一种解决方法，我一直在循环检查空白单元格并从另一列复制它。

您可以想象，这给运行时增加了烦人的秒数。

有没有一种方法可以使所有数据正确显示在查询中？

Option Explicit

Public Sub report_SourceDataFile()
    Dim connection As New ADODB.connection
    Dim rs As New ADODB.Recordset
    Dim wbSource As Workbook
    Dim strConn As String,strQuery As String,strPath As String
    Dim shtArr As Variant,shtElm As Variant
    Dim i As Long,j As Long,lastrow As Long

    Set wbSource = Workbooks.Add
    shtArr = Array("sht1","sht2","sht3")

    For i = 2018 To 2020
        strPath = "path" & i & ".xlsm"
        strConn = "Provider=microsoft.ACE.OLEDB.12.0;Data Source=" & strPath & ";Extended Properties=""Excel 12.0;HDR=Yes;"";"
        connection.Open strConn

        For Each shtElm In shtArr
            wbSource.Sheets.Add(after:=wbSource.Sheets(wbSource.Sheets.Count)).Name = shtElm
            strQuery = "SELECT * FROM [" & shtElm & "$]"
            rs.Open strQuery,connection

            ' Write header
            If i = 2018 Then
                For j = 0 To rs.Fields.Count - 1
                    wbSource.Sheets(shtElm).Cells(1,j + 1).Value = rs.Fields(j).Name
                Next j
            End If

            lastrow = wbSource.Sheets(shtElm).Cells(wbSource.Sheets(shtElm).Rows.Count,4).End(xlUp).Row
            wbSource.Sheets(shtElm).Cells(lastrow + 1,1).CopyFromRecordset rs
            rs.Close
        Next shtElm

        connection.Close
    Next i
End Sub

谢谢您的任何建议！周末愉快！