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

zxyu

    求助：通过学习赵老师的插入并更新access数据库代码，可是在数据量大（2万条以上），字段多（158个字段）数据库存放在局域网内的服务器上（没有上传附件），使用以下代码时更新速度很慢，怎么改写希望能得到帮助，谢谢了！

上传.rar (372.37 KB, 下载次数: 8)

2014-12-25 17:17 上传

点击文件名下载附件

登陆用户名：焦勇
密码：123456
数据库密码：123
vba工程密码：123457

需要按照申请时间和身份证号码两个字段同时相同更新记录（现在当数据库数据存放在局域网服务器上，数据量大的时候更新速度很慢）。
另外关闭弹出vba工程密码不知什么缘故。

1. 
   
2. Sub 上传保存数据()
   
3. Sheets("农户台账新").Activate
   
4. If Cells(2, 2) = "" Then
   
5. MsgBox ("输入信息请从第二行往下输入!")
   
6. Exit Sub
   
7. ElseIf Cells(2, 65) = "" Then
   
8. MsgBox ("请输入经办客户经理!")
   
9. Exit Sub
   
10. ElseIf Cells(2, 2) <> "" Then
    
11. 
    
12. aa = Timer   '获取当前时间
    
13. 
    
14.     Dim CNN As New ADODB.Connection
    
15.     Dim sql$, s$
    
16.      MYPATH = "\\10.52.2.6\ww\db.mdb"
    
17.      
    
18.     s = "[Excel 8.0;Database=" & ThisWorkbook.FullName & "].[" & ActiveSheet.Name & "[        DISCUZ_CODE_0        ]quot; & [a1].CurrentRegion.Address(0, 0) & "]"
    
19.     CNN.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & MYPATH & ";jet oledb:database password=123"
    
20.     '删除数据库可能存在的工作表信息
    
21.    
    
22.   sql = "delete from 农户台账 where 申请时间 in(select 申请时间 from " & s & ") and 身份证号码 in(select 身份证号码 from " & s & ")"
    
23.     CNN.Execute sql
    
24. '    工作表信息追加到数据库表
    
25.     sql = "insert into 农户台账 select * from " & s
    
26.     CNN.Execute sql
    
27.     CNN.Close
    
28.     Set CNN = Nothing
    
29. 
    
30.      MsgBox "数据保存完毕:耗时" & Format(Timer - aa, "0.000") & "秒", vbInformation, "提示信息"
    
31.     End If
    
32. End Sub
    

复制代码

coby001

CNN.Execute 是很慢的

要用 recordset

魂断蓝桥

sql = "delete from 农户台账 where 申请时间 in(select 申请时间 from " & s & ") and 身份证号码 in(select 身份证号码 from " & s & ")"

in或者not in 本身就慢

身份证号码添加索引，然后

循环语句
for
sql = "delete from 农户台账 where 申请时间 =### and 身份证号码 =###
next
这样试下。

zhaogang1960

请参考我的另一个帖子：
根据工作表批量更新Access数据库并向数据库添加不存在的记录(不使用循环)
http://club.excelhome.net/thread-1023579-1-1.html

zxyu

zhaogang1960 发表于 2014-12-24 13:41
请参考我的另一个帖子：
根据工作表批量更新Access数据库并向数据库添加不存在的记录(不使用循环)
http:/ ...

非常感谢赵老师的帮助，希望你也能多休息，身体健康，节日快乐。

zxyu

使用了赵老师的《根据工作表批量更新Access数据库并向数据库添加不存在的记录(不使用循环) 》代码，又有了新问题，字段名为1姓名、2姓名、3姓名这种的会提示语法错误（操作符丢失），如果把字段名改为姓名1、姓名2、等，又会出问题，主要是我的字段数太多了，是从A到FB列，共158个。

zhaogang1960

zxyu 发表于 2014-12-25 09:26
使用了赵老师的《根据工作表批量更新Access数据库并向数据库添加不存在的记录(不使用循环) 》代码，又有了新 ...

上传附件吧，保留少量模拟数据，并说明按照哪个字段更新

zxyu

zhaogang1960 发表于 2014-12-25 11:30
上传附件吧，保留少量模拟数据，并说明按照哪个字段更新

附件已经上传。谢谢赵老师。
登陆用户名：焦勇
密码：123456
数据库密码：123
vba工程密码：123457

需要按照申请时间和身份证号码两个字段同时相同更新记录（现在当数据库数据存放在局域网服务器上，数据量大的时候更新速度很慢）。


另外关闭弹出vba工程密码不知什么缘故。

zhaogang1960

zxyu 发表于 2014-12-25 17:19
附件已经上传。谢谢赵老师。
登陆用户名：焦勇
密码：123456

用个笨办法吧：

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.             rs.Fields(1) = arr(i, 2)
    
25.             For j = 4 To rs.Fields.Count
    
26.                 rs.Fields(j - 1) = arr(i, j)
    
27.             Next j
    
28.             rs.Update
    
29.         End If
    
30.     Next i
    
31.     MsgBox "数据保存完毕！", vbInformation + vbOKOnly
    
32.     rs.Close
    
33.     cnn.Close
    
34.     Set rs = Nothing
    
35.     Set cnn = Nothing
    
36. End Sub
    

复制代码

zhaogang1960

速度可能很慢，请测试附件
上传.rar (135.03 KB, 下载次数: 9)

2014-12-25 20:07 上传

点击文件名下载附件