慢运行循环。寻找每次执行执行多条记录的方法

Question

我有一个包含大约 5,000 行数据的 Excel 工作簿。我有两个按钮映射到宏。一个按钮将删除表中的所有数据，然后从 Excel 工作簿中重新插入，另一个按钮将仅插入基于唯一 ID 的“新”行。

我发现这两个按钮都需要很长时间才能运行。约 10-15 分钟。现在，它正在为每一行执行插入，但我希望将其结合起来。

基本上，我想循环遍历大约 100 行然后插入。然后遍历接下来的一百行并插入。

任何建议将不胜感激。一般而言，VBA / 编码不是我的强项，我在这上面拉了一堵砖墙。

谢谢！

Sub Rebuild_Click()

' ***********************
' ** Declare Variables **
' ***********************
    Dim conn As New ADODB.Connection
    Dim iRowNo As Integer
    Dim sSTATUS, sCHANNEL, sISSUE, sLOB, sDESC, sIN, sJN, sIS, sPRIME, sIU, sTR, sAU As String
    Dim answer, sQTY, sRRSC, sOA, sMeetings, sOutages As Integer
    Dim sDATE As Date
    With Sheets("OASYS ADMIN TRACKER")

' ****************************
' ** Show Information Popup **
' ****************************
        answer = MsgBox("You are about to update the database with ~5,000 records." & vbCrLf & "" & vbCrLf & "This will take approximately 5 minutes." & vbCrLf & "" & vbCrLf & "If you wish to continue, please press Yes. Otherwise, Press No" & vbCrLf & "" & vbCrLf & "----------" & vbCrLf & "EXCEL IS NOT FROZEN." & vbCrLf & "" & vbCrLf & "****DO NOT CLOSE EXCEL ****", vbYesNo + vbQuestion, "Update Database")

' ***********************
' ** Open IF Statement **
' ***********************
        If answer = vbYes Then

            ' ***********************
            ' ** Connection String **
            ' ***********************
                conn.Open "Provider=SQLNCLI11;Password=XXXXX;User ID=XXXXX;Initial Catalog=SupportAdmin;Data Source=tcp:XXXXX;"

            ' *************************
            ' ** Purge Existing Data **
            ' *************************
                conn.Execute "Delete FROM dbo.TestDB"

            ' *********************
            ' ** Skip Leader Row **
            ' *********************
                iRowNo = 4

            ' ************************
            ' ** Begin Dataset Loop **
            ' ************************
                Do Until .Cells(iRowNo, 3) = ""
                    sID = .Cells(iRowNo, 1)
                    sSTATUS = .Cells(iRowNo, 2)
                    sDATE = .Cells(iRowNo, 3)
                    sCHANNEL = .Cells(iRowNo, 4)
                    sISSUE = .Cells(iRowNo, 5)
                    sQTY = .Cells(iRowNo, 6)
                    sLOB = .Cells(iRowNo, 7)
                    sDESC = .Cells(iRowNo, 8)
                    sIN = .Cells(iRowNo, 9)
                    sJN = .Cells(iRowNo, 10)
                    sIS = .Cells(iRowNo, 11)
                    sPRIME = .Cells(iRowNo, 12)
                    sIU = .Cells(iRowNo, 13)
                    sTR = .Cells(iRowNo, 14)
                    sAU = .Cells(iRowNo, 15)
                    sRRSC = .Cells(iRowNo, 16)
                    sOA = .Cells(iRowNo, 17)
                    sOutages = .Cells(iRowNo, 18)
                    sMeetings = .Cells(iRowNo, 19)

            ' ***********************
            ' ** Replace ' in Data **
            ' ***********************
                sDESC = Replace(sDESC, "'", "''")
                sIS = Replace(sIS, "'", "''")
                sIU = Replace(sIU, "'", "''")

            ' *****************
            ' ** Execute SQL **
            ' *****************
                conn.Execute "insert into dbo.TestDB (ID,STATUS,DATE,CHANNEL,ISSUE,QTY,LOB,[DESC],[IN],JN,[IS],PRIME,IU,TR,AU,RRSC,OA,OUTAGES,MEETINGS) " & _
                             "values ('" & sID & "','" & sSTATUS & "', '" & sDATE & "','" & sCHANNEL & "', '" & sISSUE & "', '" & sQTY & "', '" & sLOB & "', '" & sDESC & "', '" & sIN & "', '" & sJN & "', '" & sIS & "', '" & sPRIME & "', '" & sIU & "', '" & sTR & "', '" & sAU & "', '" & sRRSC & "', '" & sOA & "', '" & sOutages & "', '" & sMeetings & "')"

                iRowNo = iRowNo + 1
             Loop

' ****************************
' ** Show Information Popup **
' ****************************
        MsgBox "Database Update Complete!"

' *****************************
' ** Close Connection String **
' *****************************
        conn.Close
        Set conn = Nothing

' ****************************
' ** Close IF Statement **
' ****************************
        Else
           ' do nothing
     End If

    End With

End Sub

Answer 1

在本地 SQL Server 2005 中使用临时表尝试了您的代码，发现大约 5000 条记录只需要 10 秒。在您的情况下，延迟可能是由于数据库大小、网络速度等原因。

但是，在尝试使用代码同时插入 100 条记录后，减少到仅 1 奇数秒。

Sub test2()
Dim conn As New ADODB.Connection
Dim LastRow As Long, LastCol As Long, iRowNo As Long, DataArr As Variant
Dim SqStr As String, ValStr As String, Rw As Long, Cl As Long
Dim Ws As Worksheet, tm As Double
tm = Timer

conn.Open "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;;Initial Catalog=test;Data Source=USER-PC\SQLEXPRESS"
conn.Execute "Delete FROM dbo.Test"

Set Ws = ThisWorkbook.Worksheets("Sheet1")
iRowNo = 4
LastRow = Ws.Range("C" & Rows.Count).End(xlUp).Row
DataArr = Ws.Range("A" & iRowNo & ":S" & LastRow)
LastCol = UBound(DataArr, 2)

SqStr = "insert into dbo.Test (ID,STATUS,DATE,CHANNEL,ISSUE,QTY,LOB,[DESC],[IN],JN,[IS],PRIME,IU,TR,AU,RRSC,OA,OUTAGES,MEETINGS) "
'Sqlstr=Sqlstr & " Values "  'May use for Sql Server 2008 and above

    For Rw = 1 To UBound(DataArr, 1)
    DataArr(Rw, 1) = Replace(DataArr(Rw, 1), "'", "''")
    DataArr(Rw, 8) = Replace(DataArr(Rw, 8), "'", "''")
    DataArr(Rw, 13) = Replace(DataArr(Rw, 13), "'", "''")
    'ValStr = ValStr & "('"   'May use for Sql Server 2008 and above
    ValStr = ValStr & "Select '"
        For Cl = 1 To UBound(DataArr, 2)
        'ValStr = ValStr & DataArr(Rw, Cl) & IIf(Cl < LastCol, "','", "')")  'May use for Sql Server 2008 and above
        ValStr = ValStr & DataArr(Rw, Cl) & IIf(Cl < LastCol, "','", "'")   ' Used for test in Sql Server 2005
        Next Cl

        If Rw Mod 100 = 0 Then  ' exceute at 100 records
        ValStr = SqStr & ValStr
        conn.Execute ValStr
        DoEvents
        ValStr = ""
        Debug.Print Rw, Timer - tm
        Else
            If Rw < UBound(DataArr, 1) Then
            'ValStr = ValStr & ", "  'Modify Comma / Space between datasets of two rows according Sql version Syntax
            ValStr = ValStr & " UNION ALL "  'Used for test with Sql Server 2005.
            End If
        End If
    Next Rw

    If Rw Mod 100 > 0 Then
    ValStr = SqStr & ValStr
    conn.Execute ValStr
    DoEvents
    ValStr = ""
    Debug.Print Rw, Timer - tm
    End If


Debug.Print "Total Seconds Taken: " & Timer - tm
End Sub

INSERT SQl 语法以及连接字符串等可能会根据您使用的类型和版本以及@Raymond Nijland 评论中的建议进行修改。