更新access记录速度慢怎么办？已上传附件

zhaogang1960

用EXISTS语句试试看：

1. Sub addRecords() '从Excel工作表中向数据表添加纪录
   
2. '引用Microsoft ActiveX Data Objects 2.x Library
   
3.     Dim cnn As New ADODB.Connection
   
4.     Dim myPath As String
   
5.     Dim myTable As String
   
6.     myPath = ThisWorkbook.Path & "\db.mdb;jet oledb:database password=123"
   
7.     cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & myPath '连接数据库
   
8.     myTable = "农户台账"
   
9.     Sql = "DELETE FROM " & myTable & " A WHERE EXISTS(SELECT * FROM [Excel 8.0;Database=" & ThisWorkbook.FullName & "].[" & ActiveSheet.Name & "$" _
   
10.         & Range("a1").CurrentRegion.Address(0, 0) & "] WHERE 申请时间=A.申请时间 and 身份证号码=A.身份证号码)"
    
11.     cnn.Execute Sql
    
12.     Sql = "INSERT INTO " & myTable & " SELECT * FROM [Excel 8.0;Database=" _
    
13.         & ThisWorkbook.FullName & ";].[" & ActiveSheet.Name & "$" & Range("A1").CurrentRegion.Address(0, 0) & "]"
    
14.     cnn.Execute Sql
    
15.     MsgBox "纪录添加成功。", vbInformation, "添加纪录"
    
16.     cnn.Close
    
17.     Set cnn = Nothing
    
18. End Sub

复制代码

zhaogang1960

请测试附件
上传.rar (132.32 KB, 下载次数: 25)

2014-12-25 20:21 上传

点击文件名下载附件

zxyu

zhaogang1960 发表于 2014-12-25 20:06
用个笨办法吧：

太感谢了。这个办法在我的这种情况最快了。再次感谢赵老师。其他的功能能实现但是总是看着360流量监控由0.几K/S一直增加到8.几M/S，就这个始终在K/S的速度。真心感谢赵老师。

zxyu

zhaogang1960 发表于 2014-12-25 20:06
用个笨办法吧：

利用这个办法速度提升很快就是新增的记录申请时间和身份证号码两个字段添加不进去了。

魂断蓝桥

zhaogang1960 发表于 2014-12-25 20:19
用EXISTS语句试试看：

赵版主，你好，我测试了一下，用exists速度并没有提升多少，比循环速度还要慢一些，是什么原因呢？

Sub 循环删除时间() '16.38秒
Dim tim
tim = Timer
Dim i As Byte
For i = 1 To 100
    Call add
Next
Call 循环删除
MsgBox Format(Timer - tim, "0.00秒")
End Sub
Sub exists删除时间() '22.95
Dim tim
tim = Timer
Dim i As Byte
For i = 1 To 100
    Call add
Next
Call addRecords
MsgBox Format(Timer - tim, "0.00秒")
End Sub

Sub addRecords() '从Excel工作表中向数据表添加纪录
'引用Microsoft ActiveX Data Objects 2.x Library
    Dim cnn As New ADODB.Connection
    Dim myPath As String
    Dim myTable As String
    Dim SQL As String
    myPath = ThisWorkbook.Path & "\db.mdb;jet oledb:database password=123"
    cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & myPath '连接数据库
    myTable = "农户台账"
    SQL = "DELETE FROM " & myTable & " A WHERE EXISTS(SELECT * FROM [Excel 8.0;Database=" & ThisWorkbook.FullName & "].[" & ActiveSheet.Name & "$" _
        & Range("a1").CurrentRegion.Address(0, 0) & "] WHERE 申请时间=A.申请时间 and 身份证号码=A.身份证号码)"
    cnn.Execute SQL
    cnn.Close
    Set cnn = Nothing
End Sub

Sub 循环删除()
Dim cnn As New ADODB.Connection
    Dim myPath As String
    Dim myTable As String
    Dim SQL As String, arr
    arr = [a1].CurrentRegion
    myPath = ThisWorkbook.Path & "\db.mdb;jet oledb:database password=123"
    cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & myPath '连接数据库
    myTable = "农户台账"
    Dim i As Byte
    For i = 2 To UBound(arr)
        SQL = "DELETE FROM " & myTable & " WHERE 申请时间=# " & arr(i, 1) & "# and  身份证号码='" & arr(i, 3) & "'"
        cnn.Execute SQL
    Next
    cnn.Close
    Set cnn = Nothing
End Sub
Sub add() '从Excel工作表中向数据表添加纪录
'引用Microsoft ActiveX Data Objects 2.x Library
    Dim cnn As New ADODB.Connection
    Dim myPath As String
    Dim myTable As String
    Dim SQL As String
    myPath = ThisWorkbook.Path & "\db.mdb;jet oledb:database password=123"
    cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & myPath '连接数据库
    myTable = "农户台账"
   SQL = "INSERT INTO " & myTable & " SELECT * FROM [Excel 8.0;Database=" _
        & ThisWorkbook.FullName & ";].[" & ActiveSheet.Name & "$" & Range("A1").CurrentRegion.Address(0, 0) & "]"
   cnn.Execute SQL
    cnn.Close
    Set cnn = Nothing
End Sub

zhaogang1960

魂断蓝桥 发表于 2014-12-26 10:49
赵版主，你好，我测试了一下，用exists速度并没有提升多少，比循环速度还要慢一些，是什么原因呢？

Su ...

数据量很大时，如超过10000行，应该使用EXISTS速度更快，因为只执行一次SQL语句，使用逐行处理方式则需要执行10000次SQL语句

zhaogang1960

zxyu 发表于 2014-12-26 09:57
利用这个办法速度提升很快就是新增的记录申请时间和身份证号码两个字段添加不进去了。

有点问题，修改如下：

1. Sub updateaddRecords2003()
   
2. '引用Microsoft ActiveX Data Objects 2.x Library
   
3.     Dim cnn As New ADODB.Connection
   
4.     Dim rs As ADODB.Recordset
   
5.     Dim myPath As String
   
6.     Dim myTable As String
   
7.     Dim arr As Variant, i&, j&
   
8.     myPath = ThisWorkbook.Path & "\db.mdb;jet oledb:database password=123"
   
9.     cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & myPath '连接数据库
   
10.     myTable = "农户台账"
    
11.     arr = [a1].CurrentRegion
    
12.     For i = 2 To UBound(arr)
    
13.         SQL = "select * from " & myTable & " where 申请时间=#" & arr(i, 1) & "# and 身份证号码='" & arr(i, 3) & "'"
    
14.         Set rs = New ADODB.Recordset
    
15.         rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
    
16.         If rs.RecordCount = 0 Then
    
17.             rs.AddNew
    
18.             rs.Fields(1) = arr(i, 2)
    
19.             For j = 4 To rs.Fields.Count
    
20.                 rs.Fields(j - 1) = arr(i, j)
    
21.             Next j
    
22.             rs.Update
    
23.         Else
    
24.             For j = 1 To rs.Fields.Count
    
25.                 rs.Fields(j - 1) = arr(i, j)
    
26.             Next j
    
27.             rs.Update
    
28.         End If
    
29.     Next i
    
30.     MsgBox "数据保存完毕！", vbInformation + vbOKOnly
    
31.     rs.Close
    
32.     cnn.Close
    
33.     Set rs = Nothing
    
34.     Set cnn = Nothing
    
35. End Sub
    

复制代码

zhaogang1960

请测试附件
上传.rar (131.09 KB, 下载次数: 31)

2014-12-26 13:29 上传

点击文件名下载附件

魂断蓝桥

zhaogang1960 发表于 2014-12-26 13:25
数据量很大时，如超过10000行，应该使用EXISTS速度更快，因为只执行一次SQL语句，使用逐行处理方式则需要 ...

谢谢了赵版   。

gtwlren

rs.RecordCount老是等于1是参数问题吗？

rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
改了还是不行啊