我有一本Excel工作簿，其中包含约5,000行数据。我有两个按钮映射到宏。一个按钮将删除表中的所有数据，然后将其从Excel Workbook重新插入，另一个按钮将仅基于唯一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
答案 0 :(得分：0)
在本地SQL Server 2005中使用临时表对代码进行了尝试，发现仅花费10秒即可处理大约5000条记录。对于您而言，延迟可能是由于数据库大小，网络速度等引起的。
但是，尝试使用代码一次插入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
请根据您使用的类型和版本以及@Raymond Nijland注释中的建议，修改INSERT SQl语法以及连接字符串等。