数据比较的VB求教，急

hxangel1314

各位大神，小弟有一系列的数据，数据每天都有部分更新，我想各位大神帮我比较表一和表二的数据，如果表二数据和表一的一样，则在表二中显示OK,不一样的粘贴到表三。

yeminqiang

看成是某大神的ID了////

loveshailyu

先留个名，待会来看看

yeminqiang

1. Sub cdsr()
   
2.     Dim cnn As Object, rs As Object, rs1 As Object, i&, SQL$, SQL1$
   
3.     Set cnn = CreateObject("ADODB.Connection")
   
4.     cnn.Open "Provider = Microsoft.Jet.Oledb.4.0;Extended Properties ='Excel 8.0;hdr=no';Data Source =" & ThisWorkbook.FullName
   
5.     SQL = "select a.f1,a.f2,b.f2,iif(isnull(b.f2),'','OK') from [表2$] a left join [表1$] b on a.f1=b.f1 and a.f2=b.f2"
   
6.     SQL1 = "select f1,f2 from (select a.f1,a.f2,b.f2 as f3 from [表2$] a left join [表1$] b on a.f1=b.f1 and a.f2=b.f2) where f3 is null"
   
7.     Set rs = cnn.Execute(SQL)
   
8.     With Sheet2
   
9.         .Range("h1:j65535").ClearContents
   
10.         .Range("h1").CopyFromRecordset rs
    
11.     End With
    
12.        Set rs1 = cnn.Execute(SQL1)
    
13.     With Sheet5
    
14.         .Range("a1:b65535").ClearContents
    
15.         .Range("a1").CopyFromRecordset rs1
    
16.     End With
    
17.     rs.Close
    
18.     rs1.Close
    
19.     cnn.Close
    
20.     Set rs = Nothing
    
21.     Set rs1 = Nothing
    
22.     Set cnn = Nothing
    
23. End Sub
    

复制代码

loveshailyu

1. Sub SRP()
   
2.    Dim sht1, sht2, i, j, dic1, dic2, sht22(1 To 40000, 1 To 2), t As Date
   
3.     sht1 = Worksheets("表1").Range("a1").CurrentRegion
   
4.     sht2 = Worksheets("表2").Range("a1").CurrentRegion
   
5.     Set dic1 = CreateObject("scripting.dictionary")
   
6.     Set dic2 = CreateObject("scripting.dictionary")
   
7.     Range("c:c").ClearContents
   
8.    
   
9.         For i = 1 To UBound(sht2)
   
10.             dic1(sht2(i, 1) & "     " & sht2(i, 2)) = "" '添加ab列数据至数组keys中
    
11.         Next
    
12.         
    
13.         For i = 1 To UBound(sht1)
    
14.             dic2(sht1(i, 1) & sht1(i, 2)) = "" '添加ab列数据至数组keys中
    
15.         Next
    
16.         
    
17.         For i = 1 To UBound(sht2)
    
18.         
    
19.             If dic2.exists(sht2(i, 1) & "     " & sht2(i, 2)) Then '反向查找数组中是否有这个值
    
20.                 sht2(i, 1) = "OK"
    
21.             Else
    
22.                 sht2(i, 1) = "表1没有"
    
23.                 n = n + 1 '注意这里很重要，没有这个反写数据的时候无法按顺序反写
    
24.                 For j = 1 To 2
    
25.                     sht22(n, j) = Worksheets("表2").Cells(i, j)
    
26.                 Next
    
27.             End If
    
28.         Next
    
29.         
    
30.         Range("c1").Resize(UBound(sht2)) = sht2
    
31.         Worksheets("表3").Range("a1").Resize(UBound(sht22), 2) = sht22
    
32.         
    
33.         Erase sht1, sht2, sht22
    
34. 
    
35. End Sub
    

复制代码

hxangel1314

loveshailyu 发表于 2017-5-30 19:09

谢谢，搞定，十分感谢大神

hxangel1314

loveshailyu 发表于 2017-5-30 19:09

大神，你好，还要麻烦下你，能不能帮再次我修改下，变成，如果表二的列三数据大于表一的数据，显示“价格上调”，如果小于则显示“价格下降”。复制到表三的时候，能否把表一的数据在旁边显示，谢谢！