ecvel使用vba实现多条件查询，结果计算填入表格

mchwansui

各位好
    小弟在统计一个表中数据遇到了困难，一开始使用函数实现，但是因为实际数据量较大，附件中只是一部分，全部用函数的话，表格的速度非常慢，于是想使用vba实现，但是vba学艺不精，在此希望得到各位前辈的指导，谢谢。
   在统计表中获取型号及日期，在总表中根据对应的型号和日期查询出结果，结果可能为空，一条，或多条，条件查询出的结果中提取对应的订单数量求和，录入统计表中相应的单元格中。
例，如图1，统计表中C5单元格，需要填入的数据就是根据B5内的型号，及C1中的日期2015年1月，去总表中查询。图2为总表中手动筛选结果，取所有符合条件的订单数量求和，填入到统计表中的C5内。如果没有符合条件的条目，单元格内容返回空。

   

mchwansui

附件是举例图片

cflood

Sub a()
Set d = CreateObject("Scripting.Dictionary")
lastrow = Range("A65536").End(xlUp).Row
lastcol = Range("IV1").End(xlToLeft).Column
Range(Cells(2, 3), Cells(lastrow, lastcol)).ClearContents
brr = Range(Cells(1, 2), Cells(lastrow, lastcol))
arr = Worksheets("总表").Range("A2:C" & Worksheets("总表").Range("A65536").End(xlUp).Row)
For i = 1 To UBound(arr)
d(Format(arr(i, 1), "yyyymm") & arr(i, 2)) = d(Format(arr(i, 1), "yyyymm") & arr(i, 2)) + arr(i, 3)
Next i
For i = 2 To UBound(brr)
For j = 2 To UBound(brr, 2)
brr(i, j) = d(Format(brr(1, j), "yyyymm") & brr(i, 1))
Next j
Next i
Range(Cells(1, 2), Cells(lastrow, lastcol)) = brr
End Sub

zax010

Sub zz()
    Dim d, ar, br
    Set d = CreateObject("Scripting.Dictionary")
    Application.ScreenUpdating = False
    ar = Sheet2.Range("A1").CurrentRegion
    br = Sheet8.Range("A1").CurrentRegion
    For i = 2 To UBound(ar)
        sj = Format(ar(i, 1), "yyyy-m") & "-1"
        d(ar(i, 2) & sj) = d(ar(i, 2) & sj) + ar(i, 3)
    Next
    For i = 2 To UBound(br)
        For j = 3 To UBound(br, 2)
            br(i, j) = d(br(i, 2) & br(1, j))
        Next j, i
        Sheet8.Range("A1").CurrentRegion = br
        Application.ScreenUpdating = True
    End Sub

zax010

>>>>>>>>>>>>>>>>>>>>>>>>>

test.rar (128.85 KB, 下载次数: 74)

2017-5-10 09:45 上传

点击文件名下载附件

chengshanming

需要的是不是以下代码的结果？

1. Sub zz()
   
2.     Dim d, ar, br
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     Application.ScreenUpdating = False
   
5.     ar = Sheet2.Range("A1").CurrentRegion
   
6.     br = Sheet8.Range("A1").CurrentRegion
   
7.     For i = 2 To UBound(ar)
   
8.         sj = Format(ar(i, 1), "yyyy-m")
   
9.         d(ar(i, 2) & sj) = d(ar(i, 2) & sj) + ar(i, 3)
   
10.     Next
    
11.     For i = 2 To UBound(br)
    
12.         For j = 3 To UBound(br, 2)
    
13.             br(i, j) = d(br(i, 2) & Format(br(1, j), "yyyy-m"))
    
14.         Next j, i
    
15.         Sheet8.Range("A1").CurrentRegion = br
    
16.         Application.ScreenUpdating = True
    
17.     End Sub
    

复制代码

loveshailyu

楼上的大神太给力了

yue0611

chengshanming 发表于 2017-5-15 14:20
需要的是不是以下代码的结果？

楼上的大神,提取调用公式怎么写？

yue0611

zax010 发表于 2017-5-10 09:41
Sub zz()
    Dim d, ar, br
    Set d = CreateObject("Scripting.Dictionary")

楼上的大神,提取调用公式怎么写？