[已解决]搜索某时间段内特定值，并返回对应列

lmhaha

表“统计”中有数据，我想在“报表”这个表中用宏来对“统计”中的数据进行筛选，筛选的条件是“统计”表C列的时间，符合“报表”中E1至F1的范围内。同时“统计”D列要满足“报表”G1的要求。

大神们请帮帮我，谢谢啦 2017砂浆 - 副本.rar (12.03 KB, 下载次数: 12)

2017-4-18 17:06 上传

点击文件名下载附件
表在这里

最佳答案

月排行榜 / 总排行榜

Excel学徒123

2017-4-18 17:24

1. Option Explicit
   
2. 
   
3. Sub test()
   
4.     Dim arrSrc, arrRst()
   
5.     Dim lrow&
   
6.     Dim iCnt%, iCol%
   
7.     arrSrc = Worksheets("统计").Range("a1").CurrentRegion.Value
   
8.     For lrow = 1 To UBound(arrSrc)
   
9.         If arrSrc(lrow, 2) >= Range("e1") And arrSrc(lrow, 3) <= Range("f1") And arrSrc(lrow, 4) = Range("g1") Then
   
10.             iCnt = iCnt + 1
    
11.             ReDim Preserve arrRst(1 To UBound(arrSrc, 2), 1 To iCnt)
    
12.             For iCol = 1 To UBound(arrSrc, 2)
    
13.                 arrRst(iCol, iCnt) = arrSrc(lrow, iCol)
    
14.             Next
    
15.         End If
    
16.     Next
    
17.     On Error Resume Next
    
18.     If Err.Number <> 0 Then
    
19.         MsgBox "不存在该时间段查询数据", 1 + 16, "警告"
    
20.         Exit Sub
    
21.     Else
    
22.         Range("a2").Resize(iCnt, UBound(arrSrc, 2)) = Application.Transpose(arrRst)
    
23.     End If
    
24. End Sub
    

复制代码

跳转到最佳答案楼层

Excel学徒123

这种数据提取的  论坛应该很多吧

lmhaha

我想用宏来提取，并返回，因为以后会增加一些表

lmhaha

Excel学徒123 发表于 2017-4-18 17:17
这种数据提取的  论坛应该很多吧

我想用宏来提取，并返回，因为以后会增加一些表。而且我也是个菜鸟啊，大神帮帮我！！！！

Excel学徒123

1. Option Explicit
   
2. 
   
3. Sub test()
   
4.     Dim arrSrc, arrRst()
   
5.     Dim lrow&
   
6.     Dim iCnt%, iCol%
   
7.     arrSrc = Worksheets("统计").Range("a1").CurrentRegion.Value
   
8.     For lrow = 1 To UBound(arrSrc)
   
9.         If arrSrc(lrow, 2) >= Range("e1") And arrSrc(lrow, 3) <= Range("f1") And arrSrc(lrow, 4) = Range("g1") Then
   
10.             iCnt = iCnt + 1
    
11.             ReDim Preserve arrRst(1 To UBound(arrSrc, 2), 1 To iCnt)
    
12.             For iCol = 1 To UBound(arrSrc, 2)
    
13.                 arrRst(iCol, iCnt) = arrSrc(lrow, iCol)
    
14.             Next
    
15.         End If
    
16.     Next
    
17.     On Error Resume Next
    
18.     If Err.Number <> 0 Then
    
19.         MsgBox "不存在该时间段查询数据", 1 + 16, "警告"
    
20.         Exit Sub
    
21.     Else
    
22.         Range("a2").Resize(iCnt, UBound(arrSrc, 2)) = Application.Transpose(arrRst)
    
23.     End If
    
24. End Sub
    

复制代码

Excel学徒123

lmhaha 发表于 2017-4-18 17:21

看5楼

lmhaha

Excel学徒123 发表于 2017-4-18 17:24

已经测试，太好用了，谢谢太感谢了