怎么用SQL的方法将两个工作表的不同记录导到新工作表中？

zhaogang1960

请注意，4列都不能有空格，否则SQL语句需要重写
请看附件
如何用SQL将2个工作表的相同和不同的记录生成新的工作表.rar (301.7 KB, 下载次数: 371)

2013-1-29 11:26 上传

点击文件名下载附件

nhygm

zhaogang1960 发表于 2013-1-29 11:18
第一个问题请参考：

Dim cnn As ADODB.Connection    提示用户定义类型未定义？？
Dim SQL$, sh As Worksheet
    Set cnn = New ADODB.Connection
    cnn.Open "provider=microsoft.jet.oledb.4.0;extended properties='excel 8.0;hdr=no';data source=" & ThisWorkbook.FullName
    SQL = "select a.* from [Sheet1$] a left join [Sheet2$] b  on a.f1=b.f1 and a.f2=b.f2 and a.f3=b.f3 and a.f4=b.f4 where b.f1 is null"
    On Error Resume Next
    Set sh = Sheets("Sheet1独有")
    If Not sh Is Nothing Then
        sh.Cells.Clear
    Else
        Sheets.Add.Name = "Sheet1独有"
    End If
    Sheets("Sheet1独有").Range("A1").CopyFromRecordset cnn.Execute(SQL)
    cnn.Close
    Set cnn = Nothing
End Sub

yqdaqinqin

zhaogang1960 发表于 2013-1-29 11:24
第二个问题请参考：

这个代码会打乱a列顺序！

zhaogang1960

yqdaqinqin 发表于 2013-1-29 11:30
这个代码会打乱a列顺序！

SQL没有行号概念，总会按照某列排序，如果想保持原顺序，建议使用数组+字典方法
以A列为准：

1. Sub Sheet1独有()
   
2.     Dim cnn As Object, SQL$, sh As Worksheet
   
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.* from [Sheet1$] a left join [Sheet2$] b  on a.f1=b.f1 where b.f1 is null"
   
6.     On Error Resume Next
   
7.     Set sh = Sheets("Sheet1独有")
   
8.     If Not sh Is Nothing Then
   
9.         sh.Cells.Clear
   
10.     Else
    
11.         Sheets.Add.Name = "Sheet1独有"
    
12.     End If
    
13.     Sheets("Sheet1独有").Range("A1").CopyFromRecordset cnn.Execute(SQL)
    
14.     cnn.Close
    
15.     Set cnn = Nothing
    
16. End Sub
    
17. 
    
18. 
    
19. Sub 相同记录()
    
20.     Dim cnn As Object, SQL$, sh As Worksheet
    
21.     Set cnn = CreateObject("ADODB.Connection")
    
22.     cnn.Open "provider=microsoft.jet.oledb.4.0;extended properties='excel 8.0;hdr=no';data source=" & ThisWorkbook.FullName
    
23.     SQL = "select a.* from [Sheet1$] a,[Sheet2$] b where a.f1=b.f1"
    
24.     On Error Resume Next
    
25.     Set sh = Sheets("相同记录")
    
26.     If Not sh Is Nothing Then
    
27.         sh.Cells.Clear
    
28.     Else
    
29.         Sheets.Add.Name = "相同记录"
    
30.     End If
    
31.     Sheets("相同记录").Range("A1").CopyFromRecordset cnn.Execute(SQL)
    
32.     cnn.Close
    
33.     Set cnn = Nothing
    
34. End Sub
    
35. 
    

复制代码

yqdaqinqin

zhaogang1960 发表于 2013-1-29 11:32
SQL没有行号概念，总会按照某列排序，如果想保持原顺序，建议使用数组+字典方法
以A列为准：

就是这个问题，如果A列数字长度不一样，计算完那个排序乱昏昏，特别是有合并行之后，把结果一输出那个乱的！

yqdaqinqin

zhaogang1960 发表于 2013-1-29 11:32
SQL没有行号概念，总会按照某列排序，如果想保持原顺序，建议使用数组+字典方法
以A列为准：

赵老师有数组加字典的例子麻烦贡献一个，让同志么学习学习

zhaogang1960

yqdaqinqin 发表于 2013-1-29 11:40
赵老师有数组加字典的例子麻烦贡献一个，让同志么学习学习

请参考：

1. Sub 字典法()
   
2.     Dim d(1 To 3) As Object, t, arr(1 To 2), brr(), i&, j&, m&, sh As Worksheet
   
3.     For i = 1 To 3
   
4.         Set d(i) = CreateObject("scripting.dictionary")
   
5.     Next
   
6.     For l = 1 To 2
   
7.         arr(l) = Sheets("Sheet" & l).[a1].CurrentRegion
   
8.         For i = 1 To UBound(arr(l))
   
9.             d(l)(arr(l)(i, 1)) = i
   
10.         Next
    
11.     Next
    
12.     ReDim brr(0 To UBound(arr(1)), 1 To 4)
    
13.     For i = 1 To UBound(arr(1))
    
14.         If d(1).Exists(arr(1)(i, 1)) And d(2).Exists(arr(1)(i, 1)) Then
    
15.             For j = 1 To 4
    
16.                 brr(m, j) = arr(1)(i, j) '相同记录
    
17.             Next
    
18.             d(1).Remove (arr(1)(i, 1)) 'Sheet1独有
    
19.             m = m + 1
    
20.         End If
    
21.     Next
    
22.     On Error Resume Next
    
23.     Set sh = Sheets("相同记录")
    
24.     If Not sh Is Nothing Then sh.Cells.Clear Else Sheets.Add.Name = "相同记录"
    
25.     Sheets("相同记录").[a1].Resize(m, 4) = brr
    
26.     t = d(1).items
    
27.     For i = 0 To d(1).Count - 1
    
28.         For j = 1 To 4
    
29.             brr(i, j) = arr(1)(t(i), j)
    
30.         Next
    
31.     Next
    
32.     Set sh = Sheets("Sheet1独有")
    
33.     If Not sh Is Nothing Then sh.Cells.Clear Else Sheets.Add.Name = "Sheet1独有"
    
34.     Sheets("Sheet1独有").[a1].Resize(i, 4) = brr
    
35. End Sub
    

复制代码

zhaogang1960

假设A列没有重复，或有重复只提取一行记录，否则需要重写
请看附件
字典法.rar (298.52 KB, 下载次数: 139)

2013-1-29 12:54 上传

点击文件名下载附件

ddhhyy16

这个也是我需要滴，把所有数据导入到报表模版中，具体应该怎么做呢？

zhaogang1960

ddhhyy16 发表于 2013-1-30 08:10
这个也是我需要滴，把所有数据导入到报表模版中，具体应该怎么做呢？

请模拟效果