缓慢的VBA循环 - 从记录集粘贴

问题描述：

我使用一个循环而不是copyfromrecordset来解决由于某些未知原因而中断copyfromrecordset的两列。当我循环播放时，需要2分钟才能完成800行，看起来非常慢。 Copyfromrecordset可以在不到20秒的时间内输入多达10倍列的800行。任何人都可以说出让循环如此缓慢的原因吗？缓慢的VBA循环 - 从记录集粘贴

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'只需在一个传输步骤中将整个记录集传输到工作表中。） – YowE3K

当您尝试使用'CopyFromRecordset'时，您是否使用单个单元格地址？不管Recordset的大小如何，当范围指向lop左边单元格时，“CopyFromRecordset”效果最好。如果'CopyFromRecordset'导致你的问题，你可能会考虑'GetRows'函数将数据作为一个数组返回，那么你需要转置数组并且一步插入*整个*数组。 – ThunderFrame

我是这个建议的忠实粉丝^^^^^^^ –

答

感谢@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的经验;但是，如果每行都出现屏幕更新，则可以关闭屏幕，并且速度可能会有所提高。这帮了我以前的'直到'/'循环'。

我也将关闭计算，特别是在有大量公式的大型电子表格中。如果Excel代码中有自动更新计算的位置，工作簿的重新计算可能会减慢速度。

application.screenupdating = false 
Application.Calculation = xlCalculationManual 

'your code' 

application.screenupdating = true 
Application.Calculation = xlCalculationAutomatic

缓慢的VBA循环 - 从记录集粘贴

相关推荐