Access VBA根据特定的条件，将excel表中的数据更新到Access数据库中

清风明月九

谢谢楼主的分享！很有用啊。

mm050610

努力学习中，谢谢分享！

ouyli

zhaogang1960 发表于 2013-6-3 17:31
请看附件

老师，如果例子中加一列时间。
由于教师可能换号码，所以需要增加最新时间的信息，把数据库里旧的信息删掉。
可不可以实现呢？

zhaogang1960

ouyli 发表于 2013-10-27 14:42
老师，如果例子中加一列时间。
由于教师可能换号码，所以需要增加最新时间的信息，把数据库里旧的信息删 ...

请上传附件说明要求

ouyli

zhaogang1960 发表于 2013-10-27 18:27
请上传附件说明要求

test.rar (22.83 KB, 下载次数: 20)

2013-11-2 14:47 上传

点击文件名下载附件

麻烦老师了{:soso_e144:}

zhaogang1960

ouyli 发表于 2013-11-2 14:48
麻烦老师了

1. Sub 更新插入数据()
   
2.     Dim cnn As Object, rs As Object, SQL$
   
3.     Dim arr, i&, s$, t, d As Object
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     arr = [a1].CurrentRegion
   
6.     For i = 2 To UBound(arr)
   
7.         s = arr(i, 1) & Chr(9) & arr(i, 2)
   
8.         If Not d.Exists(s) Then
   
9.             d(s) = i
   
10.         ElseIf arr(i, 8) > arr(d(s), 8) Then
    
11.             d(s) = i
    
12.         End If
    
13.     Next
    
14.     t = d.items
    
15.     Set cnn = CreateObject("adodb.connection")
    
16.     cnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\test.accdb"
    
17.     For i = 0 To d.Count - 1
    
18.         r = t(i)
    
19.         SQL = "select * from Sheet1 where LastName='" & arr(r, 1) & "' and  FirstName='" & arr(r, 2) & "'"
    
20.         Set rs = CreateObject("adodb.Recordset")
    
21.         rs.Open SQL, cnn, 1, 3
    
22.         If rs.RecordCount = 0 Then
    
23.             rs.AddNew
    
24.             For j = 1 To 8
    
25.                 rs.Fields(j - 1).Value = arr(r, j)
    
26.             Next
    
27.             rs.Update
    
28.         Else
    
29.             For j = 3 To 8
    
30.                 rs.Fields(j - 1).Value = arr(r, j)
    
31.             Next
    
32.             rs.Update
    
33.         End If
    
34.     Next
    
35.     MsgBox "数据保存完毕！", vbInformation + vbOKOnly
    
36.     rs.Close
    
37.     cnn.Close
    
38.     Set rs = Nothing
    
39.     Set cnn = Nothing
    
40. End Sub
    

复制代码

zhaogang1960

请看附件
test.rar (31.9 KB, 下载次数: 148)

2013-11-2 15:14 上传

点击文件名下载附件

ouyli

zhaogang1960 发表于 2013-11-2 15:15
请看附件

嗯，就是这样的。太感谢了。
我觉得这个可以应用到实际中去，比如建立材料价格库之类的。

tesiroys

zhaogang1960 发表于 2013-11-2 15:15
请看附件

老师，你好！请问如果我的列数增加了 该如何修改参数啊？谢谢！

qangsheng

做个报价资料库是个好思路。