五万行excel 数据导入ACCESS，需要半小时，如何提速？

zhaogang1960

1. Sub 插入数据()
   
2. 
   
3. Dim tt
   
4.     tt = Timer
   
5.     Dim cnn As Object, rs As Object, SQL$
   
6.     Dim arr, i&, s$, s2$, t$
   
7.     arr = Range("A1", [iv1].End(1))
   
8.     For i = 1 To UBound(arr, 2)
   
9.         If arr(1, i) <> "姓名" And arr(1, i) <> "手机" Then
   
10.             s = s & ",last(" & arr(1, i) & ") as " & arr(1, i)
    
11.             s2 = s2 & ",a." & arr(1, i) & "=b." & arr(1, i)
    
12.         Else
    
13.             s = s & "," & arr(1, i)
    
14.         End If
    
15.     Next
    
16. 
    
17. '下面临时表，过度一下
    
18.     Set cnn = CreateObject("adodb.connection")
    
19.     cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\通讯录.mdb"
    
20.       
    
21.     SQL = "select " & Mid(s, 2) & " from [Excel 8.0;Database=" & ThisWorkbook.FullName & "].[" & ActiveSheet.Name & "$" & [a1].CurrentRegion.Address(0, 0) & "] group by 姓名,手机"
    
22.     SQL = "insert into temp " & SQL
    
23.     cnn.Execute SQL '把工作表中不重复记录(相同记录取最后的)导入到临时表
    
24.    
    
25.   '下面是临时表的数据添加或者追加到通讯录---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
    
26.     SQL = "update 通讯录 a,temp b set " & Mid(s2, 2) & " where a.姓名=b.姓名 and a.手机=b.手机"
    
27.     cnn.Execute SQL '不判断，更新可能存在的姓名和手机记录
    
28.     SQL = "select a.* from (select " & Mid(s, 2) & " from temp group by 姓名,手机) a  left join 通讯录 b on a.姓名=b.姓名 and a.手机=b.手机  where b.姓名 is null"
    
29.     Set rs = CreateObject("adodb.recordset")
    
30.     rs.Open SQL, cnn, 1, 3
    
31.     If rs.RecordCount Then
    
32.         SQL = "insert into 通讯录 " & SQL
    
33.         cnn.Execute SQL
    
34.         MsgBox rs.RecordCount & "行数据已经添加到数据库！用时" & Timer - tt & "秒", vbInformation
    
35.     Else
    
36.          MsgBox "工作表的数据数据库中已经存在。", vbInformation
    
37.     End If
    
38.    
    
39.     SQL = "delete from temp"
    
40.     cnn.Execute SQL '最后删除临时表中的记录
    
41.     rs.Close
    
42.     cnn.Close
    
43.     Set rs = Nothing
    
44.     Set cnn = Nothing
    
45. End Sub
    

复制代码

zhaogang1960

临时表不需要ID号，删除它：
access数据上传.rar (1.97 MB, 下载次数: 188)

2013-4-18 19:45 上传

点击文件名下载附件

还可以考虑临时工作表，或在原工作表上面生成一个不重复数据区域，再导入到数据库，而不在数据库中创建一个多余的临时数据表

沉默的流星

老师：您说得对，您的建议“临时工作表”，我会考虑的，下面还有一个问题想问您。

您看看下面这一语句对不对啊？我想加一个条件,要求“工作单位”是“EXCEL HOME”
SQL = "select " & Mid(s, 2) & " from [Excel 8.0;Database=" & ThisWorkbook.FullName & "].[" & ActiveSheet.Name & "$" & [a1].CurrentRegion.Address(0, 0) & "] group by 姓名,手机 where 工作单位='EXCEL HOME'

沉默的流星

老师：您的数据导入到临时表的时候，为什么，数据顺序是乱的啊？？？

zhaogang1960

沉默的流星 发表于 2013-4-18 20:54
老师：您的数据导入到临时表的时候，为什么，数据顺序是乱的啊？？？

数据库没有行号概念，插入的数据总会以某个字段排序

沉默的流星

老师：您看看下面这一语句对不对啊？我想加一个条件,要求“工作单位”是“EXCEL HOME”
SQL = "select " & Mid(s, 2) & " from [Excel 8.0;Database=" & ThisWorkbook.FullName & "].[" & ActiveSheet.Name & "$" & [a1].CurrentRegion.Address(0, 0) & "] group by 姓名,手机 where 工作单位='EXCEL HOME'  "

zhaogang1960

沉默的流星 发表于 2013-4-18 21:34
老师：您看看下面这一语句对不对啊？我想加一个条件,要求“工作单位”是“EXCEL HOME”
SQL = "select " & ...

顺序错误

1. SQL = "select " & Mid(s, 2) & " from [Excel 8.0;Database=" & ThisWorkbook.FullName & "].[" & ActiveSheet.Name & "$" & [a1].CurrentRegion.Address(0, 0) & "] where 工作单位='EXCEL HOME' group by 姓名,手机"

复制代码

RiceFantasy

知识就是力量！ zhaogang1960 强大！

沉默的流星

老师：
    真的很感激您！这么多天的耐心讲解，让我受益匪浅，也让我深深的感到，要学习的东西太多了。但是由您相伴，我想我会坚持的。很高兴，我把向您请教的都用到了工作中，特别是最后一句where的位置，我试了好多，都没通过，但是您的一个点拨，我居然完成了，好开心啊！
      真的希望您一直伴着我们这些需要帮组的人，再一次对您表示深深的感激和敬意！
      下次如果有不懂的还来找您啊，呵呵

reverie2008

学习了{:soso_e100:}