VBA：需要建议，以加快循环和记录集功能

Question

我有一个问题，运行超过10K数据，这将需要很长时间才能完成代码...任何意见，以缩短和加快循环和记录集功能？对不起，我初学级别的代码...我的代码如下：

x = 1 
Do 
    'Start connect to SQL 
    DBPath = ThisWorkbook.FullName 
    sconnect = "Provider=SQLOLEDB;SERVER=DWSQL\BCAPP;Database=MVS;Uid=mvs;Pwd=mvs;" 
    Conn.Open sconnect 

    If Sheets("Check Foil").Cells(12, 12) <> "" And Sheets("Data").Cells(x, 3).Value Like "E*" Then 
     sSQLSting = "SELECT *FROM [MVS].[dbo].[trpos_process_details] where pos_no = '" & Sheets("Data").Cells(x, 3) & "' and scan_type = 'Anode Foil' and status = 'OK' and returned = 'N'" 
    Else 
     Sheets("Data").Cells(x, 3).Value = "E" & Sheets("Data").Cells(x, 3).Value 
     sSQLSting = "SELECT *FROM [MVS].[dbo].[trpos_process_details] where pos_no = '" & Sheets("Data").Cells(x, 3) & "' and scan_type = 'Anode Foil' and status = 'OK' and returned = 'N'" 
    End If 

    'Paste SQL table 
    mrs.Open sSQLSting, Conn, adOpenForwardOnly 
    If Sheets("Data").Cells(1, 18) = "" Then 
     Sheets("Data").Cells(1, 18).CopyFromRecordset mrs 
    Else 
     Sheets("Data").Cells(Rows.Count, 18).End(xlUp).Offset(1, 0).CopyFromRecordset mrs 
    End If 
    mrs.Close 
    Conn.Close 

    x = x + 1 
Loop Until Sheets("Data").Cells(x, 3) = "" 

x = 1 
Do 
    'Start connect to SQL 
    DBPath = ThisWorkbook.FullName 
    sconnect = "Provider=SQLOLEDB;SERVER=DWSQL\BCAPP;Database=MVS;Uid=mvs;Pwd=mvs;" 
    Conn.Open sconnect 

    If Sheets("Check Foil").Cells(12, 12) <> "" Then 
     sSQLSting = "SELECT TOP 1 scan_qty FROM [MVS].[dbo].[KITTING_Details] where scan_lotno = '" & Sheets("Data").Cells(x, 23) & "'" 
    End If 

    'Paste SQL table 
    mrs.Open sSQLSting, Conn, adOpenForwardOnly 
    Sheets("Data").Cells(x, 31).CopyFromRecordset mrs 
    mrs.Close 
    Conn.Close 

    x = x + 1 
Loop Until Sheets("Data").Cells(x, 19) = "" 

x = 1 
y = 1 
Do 
    If Sheets("Data").Cells(x, 3).Value = Sheets("Data").Cells(y, 19) Then 
     Do 
      Sheets("Data").Cells(x, 17) = Application.WorksheetFunction.Sum(Sheets("Data").Cells(y, 31), Sheets("Data").Cells(x, 17)) 
      y = y + 1 
     Loop Until Sheets("Data").Cells(x, 3) <> Sheets("Data").Cells(y, 19) 
     x = x + 1 
    ElseIf Sheets("Data").Cells(x, 3).Value <> Sheets("Data").Cells(y, 19) Then 
     x = x + 1 
    End If 
Loop Until Sheets("Data").Cells(x, 3) = "" 

x = 1 
Do 
    'Start connect to SQL 
    DBPath = ThisWorkbook.FullName 
    sconnect = "Provider=SQLOLEDB;SERVER=DWSQL\BCAPP;Database=MVS;Uid=mvs;Pwd=mvs;" 
    Conn.Open sconnect 

    If Sheets("Check Foil").Cells(12, 12) <> "" Then 
     sSQLSting = "SELECT pos_qty, foil_anode_std FROM [MVS].[dbo].[trpos] where pos_no = '" & Sheets("Data").Cells(x, 3) & "'" 
    End If 

    'Paste SQL table 
    mrs.Open sSQLSting, Conn, adOpenForwardOnly 
    Sheets("Data").Cells(x, 33).CopyFromRecordset mrs 
    mrs.Close 
    Conn.Close 
    x = x + 1 
Loop Until Sheets("Data").Cells(x, 19) = "" 

lastrow = Sheets("Data").Range("C1").End(xlDown).Row 
Sheets("Data").Cells(1, 35).FormulaR1C1 = "=RC[-2]*RC[-1]" 
Sheets("Data").Cells(1, 35).Select 
Selection.AutoFill Destination:=Sheets("Data").Range("AI1:AI" & lastrow) 
Sheets("Data").Range("AI1:AI" & lastrow).Copy 
Sheets("Data").Range("AI1").PasteSpecial xlPasteValues 

谢谢...

Answer 1

主要的问题是，你写入和读取大量数据的工作表来，这是非常缓慢的。 不要将记录集转储到工作表，而是将它们转储到数组，并从那里处理数据。

记录到数组例如：

Dim ReturnArray 

Paste SQL table 
mrs.Open sSQLSting, Conn, adOpenForwardOnly 
ReturnArray = mrs.GetRows 
mrs.Close 

如果您不能重写代码或速度不是那么重要，那么倒胃口screenupdateing，计算和事件宏的开始和结束时再将其打开，这也会有所帮助。

'Turning them off 
Application.Screenupdating =False 
Application.Calculation = xlCalculateManual 
Application.EnableEvents = False 
'Your code 
'Turning them oN 
Application.Screenupdating =True 
Application.Calculation = xlCalculateAutomatic 
Application.EnableEvents = True