[已解决]如何实现每个工作表中都只要指定日期数据

追梦人亮

希望大家帮助
工作簿中有很多工作表，每个工作表中要的数据都相同，2012/10/1——2013/10/1，怎样把没用的数据删除
怎样循环实现，最好能有一个窗口出现供选择日期，同时有一个默认的日期。

最佳答案

月排行榜 / 总排行榜

爱疯

2013-10-31 15:28

1. Sub Test()
   
2.     Dim sh As Worksheet
   
3.     Dim A(), B(1 To 10 ^ 5, 1 To 3)
   
4.     Dim i&, x&, y&, s&, str$
   
5. 
   
6. 
   
7.     '删除统计结果
   
8.     Application.DisplayAlerts = False
   
9.     On Error Resume Next
   
10.     Sheets("结果").Delete
    
11.     On Error GoTo 0
    
12. 
    
13. 
    
14.     '指定日期
    
15.     x = Application.InputBox("起始日期", , "2012/10/1", , , , , 1)
    
16.     y = Application.InputBox("终止日期", , "2013/10/1", , , , , 1)
    
17.     If x = 0 Or y = 0 Then End
    
18. 
    
19. 
    
20.     '统计
    
21.     For Each sh In Sheets
    
22.         A = sh.UsedRange
    
23.         str = sh.Name
    
24.         For i = 3 To UBound(A) - 1
    
25.             If A(i, 1) >= x And A(i, 1) <= y Then
    
26.                 s = s + 1
    
27.                 B(s, 1) = A(i, 1)
    
28.                 B(s, 2) = A(i, 2)
    
29.                 B(s, 3) = str
    
30.             End If
    
31.         Next i
    
32.     Next
    
33. 
    
34. 
    
35.     '输出
    
36.     If s > 0 Then
    
37.         Sheets.Add after:=Sheets(Sheets.Count)
    
38.         ActiveSheet.Name = "结果"
    
39.         Range("a:a").NumberFormat = "yyyy/m/d"
    
40.         Range("a1").Resize(s, UBound(B, 2)) = B
    
41.         Columns(1).AutoFit
    
42.     End If
    
43. End Sub

复制代码

要指定日期数据2.rar (284.47 KB, 下载次数: 29)

2013-10-31 15:26 上传

点击文件名下载附件
楼主自己再改吧

跳转到最佳答案楼层

爱疯

1. Sub Test()
   
2.     Dim sh As Worksheet
   
3.     Dim A(), B(1 To 10 ^ 5, 1 To 3)
   
4.     Dim i&, x&, y&, s&, str$
   
5. 
   
6. 
   
7.     '删除统计结果
   
8.     Application.DisplayAlerts = False
   
9.     On Error Resume Next
   
10.     Sheets("结果").Delete
    
11.     On Error GoTo 0
    
12. 
    
13. 
    
14.     '指定日期
    
15.     x = Application.InputBox("起始日期", , "2012/10/1", , , , , 1)
    
16.     y = Application.InputBox("终止日期", , "2013/10/1", , , , , 1)
    
17.     If x = 0 Or y = 0 Then End
    
18. 
    
19. 
    
20.     '统计
    
21.     For Each sh In Sheets
    
22.         A = sh.UsedRange
    
23.         str = sh.Name
    
24.         For i = 3 To UBound(A) - 1
    
25.             If A(i, 1) >= x And A(i, 1) <= y Then
    
26.                 s = s + 1
    
27.                 B(s, 1) = A(i, 1)
    
28.                 B(s, 2) = A(i, 2)
    
29.                 B(s, 3) = str
    
30.             End If
    
31.         Next i
    
32.     Next
    
33. 
    
34. 
    
35.     '输出
    
36.     If s > 0 Then
    
37.         Sheets.Add after:=Sheets(Sheets.Count)
    
38.         ActiveSheet.Name = "结果"
    
39.         Range("a:a").NumberFormat = "yyyy/m/d"
    
40.         Range("a1").Resize(s, UBound(B, 2)) = B
    
41.         Columns(1).AutoFit
    
42.     End If
    
43. End Sub

复制代码

要指定日期数据2.rar (284.47 KB, 下载次数: 29)

2013-10-31 15:26 上传

点击文件名下载附件
楼主自己再改吧

追梦人亮

爱疯 发表于 2013-10-31 15:28
楼主自己再改吧

谢谢你哈     但这句  A = sh.UsedRange说类型不匹配是什么意思

爱疯

追梦人亮 发表于 2013-10-31 16:13
谢谢你哈     但这句  A = sh.UsedRange说类型不匹配是什么意思

那把这句改为：
A = sh.Range("a1").CurrentRegion.Value

追梦人亮

爱疯 发表于 2013-10-31 16:22
那把这句改为：
A = sh.Range("a1").CurrentRegion.Value

哈哈，谢谢啦，刚才不好意思，是我的表有问题，我的工作表里第一个是命令按钮，没有数据，所以出错了，另外我不要输出就删除即可，能不能再帮忙改改啊，老师最近给我们布置了一个对冲基金作业，要处理大量数据，所以刚入手VBA,真的非常谢谢你

追梦人亮

追梦人亮 发表于 2013-10-31 16:27
哈哈，谢谢啦，刚才不好意思，是我的表有问题，我的工作表里第一个是命令按钮，没有数据，所以出错了，另 ...

金币给你了没有，怎么这儿还写着未解决，我都设置成解决了

追梦人亮

追梦人亮 发表于 2013-10-31 16:31
金币给你了没有，怎么这儿还写着未解决，我都设置成解决了

也就是从第二个工作表开始删除，不用输出就行，如果输出得对应，这样我接下来可以做回归分析哈，谢谢了！

爱疯

要指定日期数据4.rar (259.33 KB, 下载次数: 3)

2013-10-31 16:47 上传

点击文件名下载附件
从第2个表开始，其它题意不明白

追梦人亮

爱疯 发表于 2013-10-31 16:48
从第2个表开始，其它题意不明白

因为我工作薄中第一个表是放一些命令按扭的不是数据，所以执行时，老是出错，但删除了第一个表后又没有问题了，怎样直接从第二个表开始删日期，谢谢哈

爱疯

追梦人亮 发表于 2013-10-31 16:52
因为我工作薄中第一个表是放一些命令按扭的不是数据，所以执行时，老是出错，但删除了第一个表后又没有问 ...

要指定日期数据5.rar (261.12 KB, 下载次数: 5)

2013-10-31 17:03 上传

点击文件名下载附件
只处理是6个数字（股票代码）的工作表，其它同上。