[已解决]VBA对日期进行过滤

free1024

基本信息.rar (70.13 KB, 下载次数: 31)

2013-1-13 19:14 上传

点击文件名下载附件
VBA过滤日期 附件中有详细说明，请高手指导，谢谢。

最佳答案

月排行榜 / 总排行榜

爱疯

2013-1-13 19:52

1. Sub test()
   
2.     Dim A, B, d, k, t, i
   
3. 
   
4.     Range("A1").CurrentRegion.Sort Key1:=Range("A1"), _
   
5.                                    Order1:=xlAscending, _
   
6.                                    Key2:=Range("B1"), _
   
7.                                    Order2:=xlAscending, _
   
8.                                    Header:=xlYes
   
9.     A = Range("A2:C" & Range("A65536").End(xlUp).Row)
   
10.     Set d = CreateObject("scripting.dictionary")
    
11.     For i = 1 To UBound(A)
    
12.         d(A(i, 1)) = d(A(i, 1)) & "," & A(i, 2)
    
13.     Next i
    
14.     k = d.keys: t = d.items: Set d = Nothing
    
15. 
    
16.     For i = 0 To UBound(k)
    
17.         A(i + 1, 1) = k(i)
    
18.         B = Split(t(i), ",")
    
19.         A(i + 1, 2) = B(1)
    
20.         If UBound(B) > 1 Then
    
21.             A(i + 1, 3) = B(UBound(B))
    
22.         End If
    
23.     Next i
    
24.     Range("e2:g65536").ClearContents
    
25.     [e2].Resize(i - 1, 3) = A
    
26. End Sub
    

复制代码

基本信息2.rar (122.4 KB, 下载次数: 36)

2013-1-13 19:52 上传

点击文件名下载附件

跳转到最佳答案楼层

爱疯

1. Sub test()
   
2.     Dim A, B, d, k, t, i
   
3. 
   
4.     Range("A1").CurrentRegion.Sort Key1:=Range("A1"), _
   
5.                                    Order1:=xlAscending, _
   
6.                                    Key2:=Range("B1"), _
   
7.                                    Order2:=xlAscending, _
   
8.                                    Header:=xlYes
   
9.     A = Range("A2:C" & Range("A65536").End(xlUp).Row)
   
10.     Set d = CreateObject("scripting.dictionary")
    
11.     For i = 1 To UBound(A)
    
12.         d(A(i, 1)) = d(A(i, 1)) & "," & A(i, 2)
    
13.     Next i
    
14.     k = d.keys: t = d.items: Set d = Nothing
    
15. 
    
16.     For i = 0 To UBound(k)
    
17.         A(i + 1, 1) = k(i)
    
18.         B = Split(t(i), ",")
    
19.         A(i + 1, 2) = B(1)
    
20.         If UBound(B) > 1 Then
    
21.             A(i + 1, 3) = B(UBound(B))
    
22.         End If
    
23.     Next i
    
24.     Range("e2:g65536").ClearContents
    
25.     [e2].Resize(i - 1, 3) = A
    
26. End Sub
    

复制代码

基本信息2.rar (122.4 KB, 下载次数: 36)

2013-1-13 19:52 上传

点击文件名下载附件

free1024

爱疯 发表于 2013-1-13 19:52

圆满达到预期的效果。。。顺便问一下，生成后的日期格式如何才能和之前的一样(即不带“上午”“下午”)，后面还得用于计算，我试过几次修改格式，没能成功，忘指导，谢谢。

爱疯

free1024 发表于 2013-1-14 12:57
圆满达到预期的效果。。。顺便问一下，生成后的日期格式如何才能和之前的一样(即不带“上午”“下午”)， ...

生成前后的数据，我都没发现带“上午”“下午”呀？

如果不好说，能发图说明下吗

free1024

爱疯 发表于 2013-1-14 13:22
生成前后的数据，我都没发现带“上午”“下午”呀？

如果不好说，能发图说明下吗

基本信息(上午、下午).rar (128.75 KB, 下载次数: 11)

2013-1-19 19:34 上传

点击文件名下载附件
格式

格式

爱疯

我又把1#，5#的附件看了一遍。

运行前A:B，并没上午或下午
运行后F:G，也没上午或下午

倒是5#附件里F:G的结果，为什么会带上午下午？是你从哪儿复制来的吗？运行代码后没有了。

free1024

爱疯 发表于 2013-1-19 19:46
我又把1#，5#的附件看了一遍。

运行前A:B，并没上午或下午

这个结果是我点了一下按钮后出来的。就是说原来是24小时制的，现在点了一下按钮后，变成12小时制了，这样没法再次参加运算的，也有可能是我Excel运行环境的原因吗？如果是的话，该如何解决呢？

爱疯

我运行的结果如上图。

因为你还是没说，5楼附件F:G中的数据是怎么来的？

所以我只有猜着改了下，结尾时增加了修改F:G的单元格格式。 基本信息2.rar (124.89 KB, 下载次数: 8)

2013-1-20 08:45 上传

点击文件名下载附件