慢速VBA循环-从记录集中粘贴

我使用循环而不是copyfromrecordset来处理由于未知原因而中断copyfromrecordset的两列。当我循环这个过程时，需要2分钟才能完成800行，这看起来非常慢。Copyfromrecordset可以在不到20秒的时间内输入800行，列数是前者的10倍。谁能告诉我是什么让循环如此缓慢

Set rng = Activesheet.Range("P2")
Row = 0
Do While Not Rs1.EOF
    For col = 0 To Rs1.Fields.Count - 1
            rng.Offset(Row, col).Value = Rs1(col)
    Next col
    Row = Row + 1
    Rs1.MoveNext
Loop

---

我对copyfromrecordset没有太多经验；但是，如果每行都有屏幕更新，您可以将其关闭，并可能看到速度有所提高。这对我以前的“直到完成”/“循环”有所帮助

我还将关闭计算，特别是在一个包含大量公式的大型电子表格中。如果代码中存在Excel自动更新计算的点，则重新计算工作簿确实会减慢速度

application.screenupdating = false
Application.Calculation = xlCalculationManual

'your code'

application.screenupdating = true
Application.Calculation = xlCalculationAutomatic

---

多亏了@ThunderFrame，我才能够解决我的问题。正如@YowE3k所说，我的问题是一次只做一件事。因此，我将代码更改为使用.getrows

 'Pasting data Headings then Values
     ArrRs1 = Rs1.GetRows
     For intColIndex = 0 To Rs1.Fields.Count - 1
        Range("A1").Offset(0, intColIndex).Value = Rs1.Fields(intColIndex).Name
    Next

    Dim PasteArray As Variant

    ReDim PasteArray(1 To UBound(ArrRs1, 2), 0 To UBound(ArrRs1, 1))
    For i = 1 To UBound(ArrRs1, 2)
        For j = 0 To UBound(ArrRs1, 1)
            PasteArray(i, j) = ArrRs1(j, i)
        Next
    Next

'This is pasting the data
        ActiveSheet.Range("A2").Resize(UBound(PasteArray, 1) + 1, UBound(PasteArray, 2) + 1) = PasteArray

---

它的速度很慢，因为它正在访问记录集中的每个字段，并且正在更新每个字段的工作表。CopyFromRecordset仅在一个传输步骤中将整个记录集传输到工作表。尝试CopyFromRecordset时是否使用了单个单元格地址？CopyFromRecordset在范围引用to lop left单元格时效果最佳，而不管记录集的大小。如果CopyFromRecordset给您带来了问题，您可能会考虑GETROW函数，它将返回数据作为数组，然后需要将数组转置并将整个数组插入一个步骤。除了我试图通过循环粘贴的两列之外，所有列都正常工作。get rows数组需要一个动态范围，而不是Copyfromrecordset，对吗？是的，您需要引用一个与转置数组具有相同维度的范围。换位是最痛苦的部分，出于某种原因，GetRows函数返回按列然后按行索引的数组，而不是Excel默认的先行后列。您可以作弊并使用WorksheetFunction.Transpose，但一旦记录集的记录数超过16384条，它就无法工作，因为这将超过现代版本Excel中的列数。您可能还需要检查GetRows返回的数组是基于1还是基于0，否则最终会出现off by one错误。