断断续续学了快半年，还是搞不定复杂筛选程序，求大神相助

link-k

工作原因经常需要按照周度/月度/季度统计各个项目的报修数据，自己没学好缺少系统性的练习，搞了好久还是不行，只能厚着脸皮前来请教师傅们相助，跪谢。

要求：

1.在统计工作表中插入自定义时间控件，键入“起始日期”与“结束日期”（日期区间；例如：2023/2/2至2023/2/6）
2.筛选数据源-C列【受理时间】（载入日期区间），计数返回结果至统计工作表“B1”
3.筛选数据源-E列【任务完成时间】（载入日期区间），计数返回结果至统计工作表“B2”
4.筛选数据源-D列【任务处理时限】（载入日期区间），计数返回结果至统计工作表“B3”
5.筛选数据源-C列【受理时间】（最小日期到日期区间末；例如：本表最小日期是2022/10/26至2023/2/6），并筛选数据源-D列【任务处理时限】（载入日期区间），计数返回结果至统计工作表“B4”
6.筛选数据源-C列【受理时间】（本年度初始日到日期区间末；例如：2023/1/1至2023/2/6），计数返回结果至统计工作表“B5”
7.筛选数据源-C列【受理时间】（本年度初始日到日期区间末；例如：2023/1/1至2023/2/6），筛选数据源-E列【任务完成时间】（本年度初始日到日期区间末；例如：2023/1/1至2023/2/6），计数返回结果至统计工作表“B6”
8.筛选数据源-C列【受理时间】（最小日期到日期区间末；例如：本表最小日期是2022/10/26至2023/2/6），并筛选数据源-E列【任务完成时间】（空值+勾选大于“结束日期”的时间；例如本表分别是2023/2/11和2023/2/12），计数返回结果至统计工作表“B7”
9.筛选数据源-C列【受理时间】（最小日期到日期区间末；例如：本表最小日期是2022/10/26至2023/2/6），并筛选数据源-E列【任务完成时间】（空值+勾选大于“结束日期”的时间；例如本表分别是2023/2/11和2023/2/12），并筛选数据源-F列【是否处理超时】（非空值）；计数返回结果至统计工作表“B8”

chxw68

上传的是空压缩文件。

link-k

内容已添加，谢谢大家的帮助

link-k

chxw68 发表于 2023-2-14 10:51
上传的是空压缩文件。

新文件已上传，感谢大佬的关注支持。

WANT-T

如果想要自己开发这种工具，建议参考一下现成的工具，免费的很多，teambition,极星协作等，对都是个人免费的，等你把整个的项目管理流程，管理方法啥 的基本熟悉了，再着手设计自己的趁手工具不迟；
以下为我自己设计的自己用的项目管理工具，给你几个截图看看：
1、项目整体：关注点，每个项目或者任务的整体完成交付情况；

2、工具的操作面板：各种数据的录入操作，报表统计等，从而实现项目的管理；

3、项目进度跟进：从具体负责人的角度，看每个人手里的各个项目的完成进度，如果需要关注进度的话，得进行任务拆解，我这里拆解到了二级；每个个任务都有具体的负责人，开始/截止时间等；

4、要搭建项目管理数据库，把所有的数据，收纳整理入库，方便管理：

这是基本的项目管理思路，如果你不具备设计开发能力，可以尝试用我给你推荐的工具，都能实现这些功能，比你自己瞎搞好的多，还可以多人协作；

link-k

WANT-T 发表于 2023-2-14 14:56
如果想要自己开发这种工具，建议参考一下现成的工具，免费的很多，teambition,极星协作等，对都是个人免费 ...

感谢大佬的关注支持

link-k

又是摆弄宏的一天

link-k

chxw68 发表于 2023-2-14 10:51
上传的是空压缩文件。

Sub fhxy()
Dim arr, rng As Range
On Error Resume Next
arr = Sheets("数据源").Range("a1").CurrentRegion
Sheet4.Activate
s1 = [b1]: s2 = [b2]
For x = 2 To UBound(arr)
    If arr(x, 3) < s2 And arr(x, 3) > s1 Then
        With Sheets("database")
            If rng Is Nothing Then
                Set rng = .Range(.Cells(x, 1), .Cells(x, 10))
            Else
                Set rng = Union(rng, .Range(.Cells(x, 1), .Cells(x, 10)))
            End If
        End With
    End If
Next x
If Not rng Is Nothing Then
   rng.Copy Range("c1")
End If
End Sub
又找了一个贴合度高的代码，但是统计单元格数目，应该是要先定义一个object变量，不会呀

link-k

chxw68 发表于 2023-2-14 10:51
上传的是空压缩文件。

Sub fhxy()
Dim arr, rng As Range
On Error Resume Next
arr = Sheets("数据源").Range("a1").CurrentRegion
Sheet4.Activate
s1 = [b1]: s2 = [b2]
For x = 2 To UBound(arr)
    If arr(x, 3) < s2 And arr(x, 3) > s1 Then
        With Sheets("database")
            If rng Is Nothing Then
                Set rng = .Range(.Cells(x, 1), .Cells(x, 10))
            Else
                Set rng = Union(rng, .Range(.Cells(x, 1), .Cells(x, 10)))
            End If
        End With
    End If
Next x
If Not rng Is Nothing Then
   rng.Copy Range("c1")
End If
End Sub应该是要改变量对象

link-k

chxw68 发表于 2023-2-14 10:51
上传的是空压缩文件。

大佬，求帮助呀