[已解决]如何在（数据统计）表格中，汇总出 1 . 2 . 3 . 4 . 5 . 6 .表格中的数据

80013025

如何在（数据统计）表格中，汇总出 1 . 2 . 3 . 4 . 5 . 6 .表格中的数据
如能以SQL来实现最好！
图片:
附件： Book1.rar (19.47 KB, 下载次数: 4)

2014-10-29 23:42 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

dsmch

2014-10-30 10:42

………………

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Dim arr, brr(1 To 60000, 1 To 6), w
   
3. Dim i%, j&, k%, s&, rq1#, rq2#, kh$, dq$
   
4. w = Array(1, 2, 3, 4, 5, 6) '要统计的工作表名称
   
5. rq1 = [c3]: rq2 = [c4]
   
6. For i = 0 To UBound(w)
   
7.     If Sheets("" & w(i)).[b24] <> "" Then
   
8.         With Sheets("" & w(i))
   
9.            kh = .[d4] '客户
   
10.            dq = .[d5] '客户地区
    
11.            arr = .Range("b24:e" & .Range("b65536").End(xlUp).Row)
    
12.         End With
    
13.         For j = 1 To UBound(arr)
    
14.             If arr(j, 1) >= rq1 And arr(j, 1) <= rq2 Then
    
15.                 s = s + 1
    
16.                 For k = 1 To UBound(arr, 2)
    
17.                     brr(s, 1) = kh
    
18.                     brr(s, 2) = dq
    
19.                     brr(s, k + 2) = arr(j, k)
    
20.                 Next
    
21.             End If
    
22.         Next
    
23.     End If
    
24. Next
    
25. Range("b6").Resize(s, 6) = brr
    
26. End Sub

复制代码

dsmch

………………

80013025

dsmch 发表于 2014-10-30 05:01
………………

老师！还有两个问题请老师完善下

1.查询条件添加：按（客户  客户地区   类别  备注）查询
2.表格中如新建工作表7，却统计不出里面的数据（工作表是会不断增加的）

• w = Array(1, 2, 3, 4, 5, 6) '（这里加个判断，只查询【回家】工作表之后所有工作表的数据）
• rq1 = [c3]: rq2 = [c4]'（这里加上按 客户  客户地区   类别  备注 ）查询
  

dsmch

1. Sub Macro1()
   
2. On Error Resume Next
   
3. Dim arr, brr(1 To 60000, 1 To 6)
   
4. Dim i%, j&, k%, s&, rq1#, rq2#, kh$$, dq$$
   
5. rq1 = [c3]: rq2 = [c4] '日期
   
6. kehu = [d4]: diqv = [e4]: lb = [f4]: bz = [g4]
   
7. For i = Sheets("回家").Index + 1 To Sheets.Count
   
8.     If Sheets(i).[b24] <> "" Then
   
9.         With Sheets(i)
   
10.            kh = .[d4] '客户
    
11.            dq = .[d5] '客户地区
    
12.         End With
    
13.         If kh Like "*" & kehu & "*" And dq Like "*" & diqv & "*" Then
    
14.             arr = Sheets(i).Range("b24:e" & Sheets(i).Range("b65536").End(xlUp).Row)
    
15.             For j = 1 To UBound(arr)
    
16.                 If arr(j, 1) >= rq1 And arr(j, 1) <= rq2 And arr(j, 2) Like "*" & lb & "*" And arr(j, 4) Like "*" & bz & "*" Then
    
17.                     s = s + 1
    
18.                     For k = 1 To UBound(arr, 2)
    
19.                         brr(s, 1) = kh
    
20.                         brr(s, 2) = dq
    
21.                         brr(s, k + 2) = arr(j, k)
    
22.                     Next
    
23.                 End If
    
24.             Next
    
25.         End If
    
26.     End If
    
27. Next
    
28. [b6:g65536].ClearContents
    
29. Range("b6").Resize(s, 6) = brr
    
30. End Sub

复制代码

dsmch

………………

80013025

dsmch 发表于 2014-10-30 10:42
………………

XX谢谢老师！！！！

80013025

dsmch 发表于 2014-10-30 10:42
………………

请老师移驾：http://www.excelpx.com/thread-333879-1-1.html