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

沉默的流星 · 发表于 2013-4-17 07:43

还有一个，当当前工作表数据中的姓名和手机，与数据的姓名和手机，相同的时候（即重复的时候），要更新数据库的值为当前工作表的值，这个好像没有实现啊？

沉默的流星 · 发表于 2013-4-17 07:46

您的程序，只是达到了，（当前工作表数据中的姓名和手机，与数据库的姓名和手机）一样时，不添加，但是好像并没有更新，我不知道我的体会是否正确？

reverie2008 · 发表于 2013-4-17 08:57

学习了{:soso_e100:}

mchscofield · 发表于 2013-4-17 09:26

学习了。。非常有用

gjj136138139 · 发表于 2013-4-17 09:37

更新就用update，自己看着改呗。

zhaogang1960 · 发表于 2013-4-17 12:55

沉默的流星发表于 2013-4-17 07:37
老师，提个疑惑，如果数据表几万行数据，您的那种去掉工作表重复的姓名和手机的方法，可用吗？那么长的字符 ...

一、测试一下就知道了
二、这是成熟的算法，不用怀疑

zhaogang1960 · 发表于 2013-4-17 15:10

沉默的流星发表于 2013-4-17 07:43
还有一个，当当前工作表数据中的姓名和手机，与数据的姓名和手机，相同的时候（即重复的时候），要更新数据 ...

先更新可能存在的记录，在插入不存在的记录：

Sub 插入数据()
Dim tt
tt = Timer
Dim cnn As Object, rs As Object, SQL$
Dim arr, i&, s$, s2$, t$
arr = Range("A1", [iv1].End(1))
For i = 1 To UBound(arr, 2)
If arr(1, i) <> "姓名" And arr(1, i) <> "手机" Then
s = s & ",first(" & arr(1, i) & ") as " & arr(1, i)
s2 = s2 & ",a." & arr(1, i) & "=b." & arr(1, i)
Else
s = s & "," & arr(1, i)
End If
Next
Set cnn = CreateObject("adodb.connection")
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\通讯录.mdb"
SQL = "select b.* from 通讯录 a,[Excel 8.0;Database=" & ThisWorkbook.FullName & "].[" & ActiveSheet.Name & "$" & [a1].CurrentRegion.Address(0, 0) & "] b where a.姓名=b.姓名 and a.手机=b.手机"
Set rs = CreateObject("adodb.recordset")
rs.Open SQL, cnn, 1, 3
If rs.RecordCount Then '有姓名,手机记录则更新
SQL = "update 通讯录 a,[Excel 8.0;Database=" & ThisWorkbook.FullName & "].[" & ActiveSheet.Name & "$" & [a1].CurrentRegion.Address(0, 0) & "] b set " & Mid(s2, 2) & " where a.姓名=b.姓名 and a.手机=b.手机"
cnn.Execute SQL
End If
SQL = "select a.* from (select " & Mid(s, 2) & " from [Excel 8.0;Database=" & ThisWorkbook.FullName & "].[" & ActiveSheet.Name & "$" & [a1].CurrentRegion.Address(0, 0) _
& "] group by 姓名,手机) a left join 通讯录 b on a.姓名=b.姓名 and a.手机=b.手机 where b.姓名 is null"
Set rs = CreateObject("adodb.recordset")
rs.Open SQL, cnn, 1, 3
If rs.RecordCount Then
SQL = "insert into 通讯录 " & SQL
cnn.Execute SQL
MsgBox rs.RecordCount & "行数据已经添加到数据库！用时" & Timer - tt & "秒", vbInformation
Else
MsgBox "工作表的数据数据库中已经存在。", vbInformation
End If
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
End Sub

复制代码

zhaogang1960 · 发表于 2013-4-17 15:18

请看附件

工作表数据上传Access.rar (204.91 KB, 下载次数: 151)

zhaogang1960 · 发表于 2013-4-17 16:47

改进一下，不判断是否有已经存在的记录，直接更新：

Sub 插入数据()
Dim tt
tt = Timer
Dim cnn As Object, rs As Object, SQL$
Dim arr, i&, s$, s2$, t$
arr = Range("A1", [iv1].End(1))
For i = 1 To UBound(arr, 2)
If arr(1, i) <> "姓名" And arr(1, i) <> "手机" Then
s = s & ",first(" & arr(1, i) & ") as " & arr(1, i)
s2 = s2 & ",a." & arr(1, i) & "=b." & arr(1, i)
Else
s = s & "," & arr(1, i)
End If
Next
Set cnn = CreateObject("adodb.connection")
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\通讯录.mdb"
SQL = "update 通讯录 a,[Excel 8.0;Database=" & ThisWorkbook.FullName & "].[" & ActiveSheet.Name & "$" & [a1].CurrentRegion.Address(0, 0) & "] b set " & Mid(s2, 2) & " where a.姓名=b.姓名 and a.手机=b.手机"
cnn.Execute SQL '不判断，更新可能存在的姓名和手机记录
SQL = "select a.* from (select " & Mid(s, 2) & " from [Excel 8.0;Database=" & ThisWorkbook.FullName & "].[" & ActiveSheet.Name & "$" & [a1].CurrentRegion.Address(0, 0) _
& "] group by 姓名,手机) a left join 通讯录 b on a.姓名=b.姓名 and a.手机=b.手机 where b.姓名 is null"
Set rs = CreateObject("adodb.recordset")
rs.Open SQL, cnn, 1, 3
If rs.RecordCount Then
SQL = "insert into 通讯录 " & SQL
cnn.Execute SQL
MsgBox rs.RecordCount & "行数据已经添加到数据库！用时" & Timer - tt & "秒", vbInformation
Else
MsgBox "工作表的数据数据库中已经存在。", vbInformation
End If
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
End Sub

复制代码

zhaogang1960 · 发表于 2013-4-17 16:50

请看附件

工作表数据上传Access.rar (204.82 KB, 下载次数: 147)

		自动登录	找回密码
密码			免费注册

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

点评