[已解决]无人能解的汇总难题，如有老师愿意帮忙！在此先谢过诸位老师啦！

wmw123

恳请老师帮我完成最后一个难题，在此先谢过诸位老师啦！


SQL汇总查询一最终难题.rar (48.33 KB, 下载次数: 30)

2014-11-17 22:04 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

80013025

2014-11-19 22:01

Private Sub 汇总两表数据_Click()
    Dim cn As New ADODB.Connection, t As Single
    Dim sq1 As String, sq2 As String, sq3 As String
     t = Timer
    Range("O5:T" & Range("O65536").End(xlUp).Row + 1).ClearContents
    cn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
    sq1 = "select 名称,区域,类型,数量 from [A明细$B4:G]"
    sq2 = "select 名称,区域,类型,数量 from [B明细$H4:M]"
    sq3 = "select 名称,区域," & _
    "SUM(iif(类型='A',数量,0)),SUM(iif(类型='B',数量,0)),SUM(iif(类型='C',数量,0)),SUM(iif(类型='D',数量,0))" & _
          "from ( " & sq1 & " UNION ALL " & sq2 & ") GROUP BY 名称,区域"
    Sheets("汇总").Range("O5").CopyFromRecordset cn.Execute(sq3)
    cn.Close
    Set cn = Nothing
    MsgBox "共用时：" & (Timer - t) * 1000 & "毫秒"
End Sub

跳转到最佳答案楼层

wmw123

请老师帮修改！！！！！！！

wmw123

{:201:}{:201:}{:201:}{:201:}{:201:}{:201:}{:201:}{:201:}{:201:}xlDo      _______________________________________________________

QLZ0602

什么难题？

dsmch

1. Sub Macro1()
   
2. Dim arr, brr(1 To 20000, 1 To 6), d, i%, j&, zf$$
   
3. Dim date1#, date2, mc$$, qy$$, rng As Range, n&, s&
   
4. Sheets("汇总").Activate
   
5. date1 = Range("p2"): date2 = Range("p3")
   
6. mc = Range("q3"): qy = Range("r3")
   
7. Set d = CreateObject("scripting.dictionary")
   
8. For i = 1 To 2
   
9.     Set rng = Sheets(i).UsedRange.Find("组---明细", lookat:=xlPart)
   
10.     If Not rng Is Nothing Then arr = rng.CurrentRegion
    
11.     For j = 5 To UBound(arr)
    
12.         If arr(j, 2) >= date1 And arr(j, 2) <= date2 And arr(j, 3) Like "*" & mc & "*" And arr(j, 4) Like "*" & qy & "*" Then
    
13.             zf = arr(j, 3) & "," & arr(j, 4)
    
14.             If Not d.Exists(zf) Then
    
15.                 s = s + 1
    
16.                 d(zf) = s
    
17.                 brr(s, 1) = arr(j, 3)
    
18.                 brr(s, 2) = arr(j, 4)
    
19.                 brr(s, Asc(arr(j, 5)) - 62) = arr(j, 6)
    
20.             Else
    
21.                 n = d(zf)
    
22.                 brr(n, Asc(arr(j, 5)) - 62) = brr(n, Asc(arr(j, 5)) - 62) + arr(j, 6)
    
23.             End If
    
24.         End If
    
25.     Next
    
26. Next
    
27. Range("o5").Resize(s, 6) = brr
    
28. End Sub

复制代码

wmw123

dsmch 发表于 2014-11-19 06:46

老师，可能您还没理解到我想要得到的效果
请老师看我现在发的图片说明：

wmw123

dsmch 发表于 2014-11-19 06:46

您的代码是把。a组明细a的数据与b组明细c的数据合在一起了，无法区分出b组明细c.d的数量！

wzl8007

看样子处理数据还是Access呀！

wmw123

dsmch 发表于 2014-11-19 06:46

老师以重新做说明，请老师看看
SQL汇总查询一最终难题1.rar (21.89 KB, 下载次数: 8)

2014-11-19 21:11 上传

点击文件名下载附件

80013025

Private Sub 汇总两表数据_Click()
    Dim cn As New ADODB.Connection, t As Single
    Dim sq1 As String, sq2 As String, sq3 As String
     t = Timer
    Range("O5:T" & Range("O65536").End(xlUp).Row + 1).ClearContents
    cn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
    sq1 = "select 名称,区域,类型,数量 from [A明细$B4:G]"
    sq2 = "select 名称,区域,类型,数量 from [B明细$H4:M]"
    sq3 = "select 名称,区域," & _
    "SUM(iif(类型='A',数量,0)),SUM(iif(类型='B',数量,0)),SUM(iif(类型='C',数量,0)),SUM(iif(类型='D',数量,0))" & _
          "from ( " & sq1 & " UNION ALL " & sq2 & ") GROUP BY 名称,区域"
    Sheets("汇总").Range("O5").CopyFromRecordset cn.Execute(sq3)
    cn.Close
    Set cn = Nothing
    MsgBox "共用时：" & (Timer - t) * 1000 & "毫秒"
End Sub