根据excel表数据更新有重复记录的数据库并插入数据库中不存在的记录

wadwlong

查找复制整行的代码优化
http://club.excelhome.net/thread-1050498-1-1.html
请老师帮忙改改，复制后数据要严格按照 需要核对的代码排列顺序，没有找到数据表示 XXX No found，附件内的方式执行效率低。
纠结好久了这个问题，正在积极学习VBA中

我的一生14

学习中，谢谢！，５１自学网－专业培训老师录制的视频教程，让学习变得很轻松

snoopychen1

{:soso_e179:}

reverie2008

好东西，学习了。

cys110

赵老师，求助我这个该怎么办http://club.excelhome.net/thread-1091513-1-1.html

chenwenming

赵版的字典真的用得出神入化了

龙儿k

赵老师，您好！我用您这段代码 改了一下放到SQL数据库上，用不了，能帮我看看吗？

1. Sub CommandButton2_Click()
   
2. Dim cnn As Object, rs As Object, SQL$
   
3.     Dim a, arr, i&, j&, l&, s$, k, t, d As Object
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     arr = [a3].CurrentRegion '工作表数据区域写入数组
   
6. 
   
7.    
   
8. '    用字典记录每个姓名出现在工作表中的行号
   
9.     For i = 2 To UBound(arr)
   
10.         s = arr(i, 3) & Chr(9) & arr(i, 4)
    
11.         If Not d.Exists(s) Then
    
12.             d(s) = i
    
13.         Else
    
14.             d(s) = d(s) & "," & i
    
15.         End If
    
16.     Next
    
17.     k = d.keys '不重复的姓名信息
    
18.     t = d.items '不重复的姓名出现的行号
    
19.    
    
20.     Set cnn = CreateObject("adodb.connection")
    
21.     cnn.Open "Provider=sqloledb;Server=127.0.0.1;Database=UserData;Uid=admin;Pwd=123456"
    
22.    
    
23. '    更新数据库中存在的数据
    
24.     For i = 0 To d.Count - 1
    
25.         a = Split(k(i), Chr(9)) '分离name、ID
    
26.         SQL = "select * from dbo.data where name='" & a(0) & "' and  ID='" & a(1) & "'" '查询该人员在数据除中记录
    
27.         Set rs = CreateObject("adodb.Recordset")
    
28.         rs.Open SQL, cnn, 1, 3
    
29.         n = rs.RecordCount '记录数
    
30.         If n > 0 Then '如果有记录
    
31.             a = Split(t(i), ",") '分离该人员在工作表中出现的行号
    
32.             For j = 0 To UBound(a) '逐个行号
    
33.                 If j + 1 > n Then Exit For '如果工作表中该人员记录次序大于数据库中的记录数则退出循环
    
34.                 rs.Move j, 1 '把指针移动到该人员出现次序的位置
    
35.                 For l = 5 To 34 '逐列数据更新到数据库
    
36.                     rs.Fields(l - 1) = arr(a(j), l)
    
37.                 Next l
    
38.                 rs.Update '更新
    
39.             Next j
    
40.         End If
    
41.     Next i
    
42.    
    
43. '    下面是插入数据库中不存在的记录
    
44.     SQL = "select a.* from [Excel 12.0;Database=" & ThisWorkbook.FullName & "].[" & ActiveSheet.Name & "$" & [a3].CurrentRegion.Address(0, 0) _
    
45.         & "] a left join dbo.data b on a.ID=b.ID and a.name=b.name  where b.ID is null"
    
46.     Set rs = CreateObject("adodb.recordset")
    
47.     rs.Open SQL, cnn, 1, 3
    
48.     If rs.RecordCount Then
    
49.         SQL = "insert into dbo.data " & SQL
    
50.         cnn.Execute SQL
    
51.         MsgBox rs.RecordCount & "行数据已经添加到数据库！", vbInformation
    
52.     Else
    
53.          MsgBox "工作表的数据数据库中已经存在。", vbInformation
    
54.     End If
    
55.    
    
56.     rs.Close
    
57.     cnn.Close
    
58.     Set rs = Nothing
    
59.     Set cnn = Nothing
    
60.     End Sub
    

复制代码

yishang3

其实更新数据会出现多种情况：
不管什么情况，只要分配一个唯一的序号，应该都会容易操作。
对于有重复的数据，可以在表格或数据库中分配一个序号，这个是唯一的。这样可以在实际操作中进行查找并更新数据，
这样对应唯一的序号：可以进行查找、删除项、修改项以及增加项。

不太懂数据库，在平时操作电子表格遇到这样的情况。
赵老师修改下代码则应该可以成为通用代码了吧！

oulind

楼主，您的代码写得非常好，让我收益匪浅，有个问题我想请教一下，用您的附件，如果只有一条新记录的话，会提示“表达式不正确”。

zhaogang1960

oulind 发表于 2015-12-23 16:08
楼主，您的代码写得非常好，让我收益匪浅，有个问题我想请教一下，用您的附件，如果只有一条新记录的话，会 ...

没有发现该问题，请看演示：