[已解决]按日期区间提取数据

罗达

日期作为变量，按照区间提取数据，具体见附件

最佳答案

月排行榜 / 总排行榜

grf1973

2016-4-15 15:32

注意：源数据的表头中不要有换行符，不然查询内容无法匹配

1. Sub 查询()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     cx = "品名,规格,批号,投料量,单价,半成品数量,半成品收率,成品数量,成品收率,成品定额,定额数量,节超数量,节约金额,杂质,灰屑,质量情况,备注"
   
4.     cxrr = Split(cx, ",")
   
5.     arr = Sheets("数据统计2016").[a1].CurrentRegion
   
6.     ReDim brr(1 To UBound(arr), 1 To UBound(cxrr) + 1)
   
7.     For j = 1 To UBound(arr, 2)      '表头与列号挂钩
   
8.         d(arr(1, j)) = j
   
9.     Next
   
10.     For j = 0 To UBound(cxrr)     '查询内容与源表列号挂钩
    
11.         cxrr(j) = d(cxrr(j))
    
12.     Next
    
13.    
    
14.     rq1 = [b3]: rq2 = [c3]
    
15.     For i = 1 To UBound(arr)
    
16.         rq = arr(i, 15)
    
17.         If rq >= rq1 And rq <= rq2 Then
    
18.             n = n + 1
    
19.             For j = 1 To UBound(brr, 2)
    
20.                 brr(n, j) = arr(i, cxrr(j - 1))
    
21.             Next
    
22.         End If
    
23.     Next
    
24.     [a8:z1000] = ""
    
25.     [a8].Resize(1, UBound(brr, 2)) = Split(cx, ",")
    
26.     [a9].Resize(n, UBound(brr, 2)) = brr
    
27. End Sub
    

复制代码

跳转到最佳答案楼层

罗达

顶一下，沉到底了都。求大咖关注，难道是太简单？

grf1973

注意：源数据的表头中不要有换行符，不然查询内容无法匹配

1. Sub 查询()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     cx = "品名,规格,批号,投料量,单价,半成品数量,半成品收率,成品数量,成品收率,成品定额,定额数量,节超数量,节约金额,杂质,灰屑,质量情况,备注"
   
4.     cxrr = Split(cx, ",")
   
5.     arr = Sheets("数据统计2016").[a1].CurrentRegion
   
6.     ReDim brr(1 To UBound(arr), 1 To UBound(cxrr) + 1)
   
7.     For j = 1 To UBound(arr, 2)      '表头与列号挂钩
   
8.         d(arr(1, j)) = j
   
9.     Next
   
10.     For j = 0 To UBound(cxrr)     '查询内容与源表列号挂钩
    
11.         cxrr(j) = d(cxrr(j))
    
12.     Next
    
13.    
    
14.     rq1 = [b3]: rq2 = [c3]
    
15.     For i = 1 To UBound(arr)
    
16.         rq = arr(i, 15)
    
17.         If rq >= rq1 And rq <= rq2 Then
    
18.             n = n + 1
    
19.             For j = 1 To UBound(brr, 2)
    
20.                 brr(n, j) = arr(i, cxrr(j - 1))
    
21.             Next
    
22.         End If
    
23.     Next
    
24.     [a8:z1000] = ""
    
25.     [a8].Resize(1, UBound(brr, 2)) = Split(cx, ",")
    
26.     [a9].Resize(n, UBound(brr, 2)) = brr
    
27. End Sub
    

复制代码

dsfada

学习了！！

罗达

grf1973 发表于 2016-4-15 15:32
注意：源数据的表头中不要有换行符，不然查询内容无法匹配

很感谢你的帮助！和我想的一样。如果有换行符，“投料时间”在代码里写成“投料_时间”行吗？就是SQL查询的表示方法在这里不行吗

罗达

grf1973 发表于 2016-4-15 15:32
注意：源数据的表头中不要有换行符，不然查询内容无法匹配

代码我改好了，谢谢，你是最佳