[已解决]求版主和各位大神帮忙，总个多表的数据对比！谢谢了

kidd1217

各位大神：

    我有几个表，我想把这几个表里的某些数据拿出来，进行对比， 就好比，某个产品 入库多少，采购多少，领用多少，这样的性质！


请各位帮忙！！谢谢了！！

最佳答案

月排行榜 / 总排行榜

xdragon

2014-9-22 15:56

1. Sub test2()
   
2.    Dim d As Object, arr, i%, j&, t, re(), dc%
   
3.    Dim gg%, cz%, zl%, sr$$
   
4.    t = Array("图纸量", "库存量", "领料量", "采购量")
   
5.    ReDim re(1 To 10000, 1 To 6)
   
6.    Set d = CreateObject("scripting.dictionary")
   
7.    For i = 0 To UBound(t)
   
8.        arr = Sheets(t(i)).Range("A1").CurrentRegion.Value
   
9.        For j = 1 To UBound(arr, 2)
   
10.            If arr(1, j) = "规格" Then gg = j
    
11.            If arr(1, j) = "材质" Then cz = j
    
12.            If arr(1, j) = "重量" Then zl = j
    
13.        Next
    
14.        For j = 2 To UBound(arr)
    
15.            sr = arr(j, gg) & "|" & arr(j, cz)
    
16.            If Not d.exists(sr) Then
    
17.                dc = d.Count + 1
    
18.                d(sr) = dc
    
19.                re(dc, 1) = arr(j, gg)
    
20.                re(dc, 2) = arr(j, cz)
    
21.            End If
    
22.            re(d(sr), i + 3) = re(d(sr), i + 3) + arr(j, zl)
    
23.        Next
    
24.        Sheets("对比表").Range("A4").Resize(d.Count, 6) = re
    
25.    Next
    
26. End Sub

复制代码

换一种方法试试{:20:}

跳转到最佳答案楼层

QLZ0602

看的头都晕了

kidd1217

QLZ0602 发表于 2014-9-22 12:58
看的头都晕了

就是把几个表的数据汇总在一起，  做个对比！！

xdragon

Sub test()
   Dim conn As Object
   Set conn = CreateObject("adodb.connection")
   conn.Open "dsn=excel files;dbq=" & ThisWorkbook.FullName
   Range("A4").CopyFromRecordset conn.Execute("transform sum(重量) select 规格,材质 from " & _
      "(select 规格,材质,重量,'a' as 种类 from [图纸量$]" & _
      "union all select 规格,材质,重量,'b' from [库存量$] union all select 规格,材质,重量,'c' from [领料量$]" & _
      "union all select 规格,材质,重量,'d' from [采购量$]) group by 规格,材质 pivot 种类")
   conn.Close
   Set conn = Nothing
End Sub

见鬼了，编辑了n次，那个$怎么每次都会多一个出来。。。。图纸量$$应该是一个$下面也一样。

dsmch

手工模拟几个结果，方便理解问题。
另外解释一下，什么是不同的产品？

kidd1217

xdragon 发表于 2014-9-22 13:08
Sub test()
   Dim conn As Object
   Set conn = CreateObject("adodb.connection")

谢谢！

很棒的SQL！！ 但是不理解你说的$

xdragon

kidd1217 发表于 2014-9-22 13:48
谢谢！

很棒的SQL！！ 但是不理解你说的$

没事，我把代码改了。

kidd1217

xdragon 发表于 2014-9-22 13:08
Sub test()
   Dim conn As Object
   Set conn = CreateObject("adodb.connection")

这代码有问题的， 当把表库存量 数据清空时，   他们的数据就乱显示，不会按照眉头写的字段显示了！！

当4个表都有数据，是正常的！

清空其中一个就错了，他会把坐边的数据自动往左边靠，而不是固定在某一列！！


为什么呢？

xdragon

1. Sub test2()
   
2.    Dim d As Object, arr, i%, j&, t, re(), dc%
   
3.    Dim gg%, cz%, zl%, sr$$
   
4.    t = Array("图纸量", "库存量", "领料量", "采购量")
   
5.    ReDim re(1 To 10000, 1 To 6)
   
6.    Set d = CreateObject("scripting.dictionary")
   
7.    For i = 0 To UBound(t)
   
8.        arr = Sheets(t(i)).Range("A1").CurrentRegion.Value
   
9.        For j = 1 To UBound(arr, 2)
   
10.            If arr(1, j) = "规格" Then gg = j
    
11.            If arr(1, j) = "材质" Then cz = j
    
12.            If arr(1, j) = "重量" Then zl = j
    
13.        Next
    
14.        For j = 2 To UBound(arr)
    
15.            sr = arr(j, gg) & "|" & arr(j, cz)
    
16.            If Not d.exists(sr) Then
    
17.                dc = d.Count + 1
    
18.                d(sr) = dc
    
19.                re(dc, 1) = arr(j, gg)
    
20.                re(dc, 2) = arr(j, cz)
    
21.            End If
    
22.            re(d(sr), i + 3) = re(d(sr), i + 3) + arr(j, zl)
    
23.        Next
    
24.        Sheets("对比表").Range("A4").Resize(d.Count, 6) = re
    
25.    Next
    
26. End Sub

复制代码

换一种方法试试{:20:}

kidd1217

xdragon 发表于 2014-9-22 15:56
换一种方法试试

谢谢！！

到现在调试还没有问题！！