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