【求助】自行判断筛选条件，按日期筛选

明天の太遥远！ · 发表于 2013-5-10 11:31

现有一张数据表，A列为时间发生的日期，B列有关人姓名，C列为时间的结果。
要求：1、窗体里选择时间起始-截止日期后，当按下“筛选”按钮时，首先按照此时间段（在A列），判断需要的数据区域。
         2、区域内判断有几种不同单元格（筛选条件非人工选择，完全是根据B列出现的人的名字来判断在此区域有几个人名字，并把这些名字自定列为筛选条件）。
         3、再统计出来符合每一个人的有成绩的单元格数量（在C列，与C列单元格内容无关，只要有几个跟B列相应的有效单元格数就行了）
         4、新创建一个新工作薄及工作表，把筛选结果显示在新工作薄里。
QQ截图20130510112950.png

筛选.zip (7.82 KB, 下载次数: 14)

grf1973 · 发表于 2013-5-10 15:11

Sub tt()
Set d = CreateObject("scripting.dictionary")
With Sheet1
arr = .[a1].CurrentRegion
stime = .[f15]: etime = .[i15]
.[a1].CurrentRegion.Interior.ColorIndex = 0
For i = 2 To UBound(arr)
If arr(i, 1) >= stime And arr(i, 1) <= etime Then
.Cells(i, 1).Interior.ColorIndex = 6
d(arr(i, 2)) = d(arr(i, 2)) + 1
End If
Next
End With
With Sheet2
.Activate
.Range("a2:b1000").ClearContents
.Cells(2, 1).Resize(d.Count, 1) = Application.Transpose(d.keys)
.Cells(2, 2).Resize(d.Count, 1) = Application.Transpose(d.items)
End With
End Sub

复制代码

其中起止时间是用数据有效性做的。

grf1973 · 发表于 2013-5-10 15:14

起止时间（[f15]和[i15]）是用数据有效性做的，结果保存在第二张工作表里。符合时间段要求的都拿黄色标注了。前面数据源的次序乱也没关系。

grf1973 · 发表于 2013-5-10 15:16

当然为防止出错可以再加些判断，比如起始时间或终止时间为空，起始时间大于终止时间等。

明天の太遥远！ · 发表于 2013-5-10 23:44

grf1973 发表于 2013-5-10 15:16
当然为防止出错可以再加些判断，比如起始时间或终止时间为空，起始时间大于终止时间等。

哥们，，谢谢你，代码运行的很好。只是我的意思是这些代码放到VBA窗体里运行的，附件里的文件里还包括一个窗体呢，你好像没注意，你写的是宏，我把它改一些后放到窗体里运行不了了，有些错误。麻烦你能不能再调一下。我的窗体已经有两个DTPicker框，相当于你所设定的[f15]和[i15]，代码的主要功能已经写得很好了，只是把它位置再调一下，谢谢你！

grf1973 · 发表于 2013-5-11 13:26

Private Sub 筛选_Click()
Set d = CreateObject("scripting.dictionary")
With Sheet1
arr = .[a1].CurrentRegion
[color=Red] stime = DTPicker1.Value: etime = DTPicker2.Value[/color]
.[a1].CurrentRegion.Interior.ColorIndex = 0
For i = 2 To UBound(arr)
If arr(i, 1) >= stime And arr(i, 1) <= etime Then
.Cells(i, 1).Interior.ColorIndex = 6
d(arr(i, 2)) = d(arr(i, 2)) + 1
End If
Next
End With
With Sheet2
.Activate
.Range("a2:b1000").ClearContents
.Cells(2, 1).Resize(d.Count, 1) = Application.Transpose(d.keys)
.Cells(2, 2).Resize(d.Count, 1) = Application.Transpose(d.items)
End With
End Sub

复制代码

grf1973 · 发表于 2013-5-11 13:27

Private Sub 筛选_Click()
Set d = CreateObject("scripting.dictionary")
With Sheet1
      arr = .[a1].CurrentRegion
      stime = DTPicker1.Value: etime = DTPicker2.Value
      .[a1].CurrentRegion.Interior.ColorIndex = 0
      For i = 2 To UBound(arr)
         If arr(i, 1) >= stime And arr(i, 1) <= etime Then
            .Cells(i, 1).Interior.ColorIndex = 6
            d(arr(i, 2)) = d(arr(i, 2)) + 1
         End If
      Next
   End With

   With Sheet2
      .Activate
      .Range("a2:b1000").ClearContents
      .Cells(2, 1).Resize(d.Count, 1) = Application.Transpose(d.keys)
      .Cells(2, 2).Resize(d.Count, 1) = Application.Transpose(d.items)
   End With
End Sub

明天の太遥远！ · 发表于 2013-5-11 13:32

{:soso_e112:}太好了，，回答很及时，很准确，，谢谢grf1973 兄弟的及时雨。。祝你身体健康、每天快乐！{:soso_e177:}{:soso_e157:}

明天の太遥远！ · 发表于 2013-5-11 16:27

明天の太遥远！发表于 2013-5-11 13:32
太好了，，回答很及时，很准确，，谢谢grf1973 兄弟的及时雨。。祝你身体健康、每天快乐！{:s ...

兄弟，，现在要上面的例子要稍微提高点，，就是说统计出这个人按某一个时间段，回答后的“不及格、及格、好、优”次数？
QQ截图20130511162524.png

筛选.zip (16.08 KB, 下载次数: 21)

好事做到底吧，，兄弟，再帮忙指导一下，好吗？谢谢你！{:soso_e157:}

		自动登录	找回密码
密码			免费注册