查询停发续发情况

lrh788

还有就是请增加开始时间判断，同时考虑我的实际数据有10多列，能否让代码自动判断数据表的列

笨鸟飞不高

lrh788 发表于 2020-7-18 13:24
如201112同时停发续发的陈华远等等有近3000人

代码是有问题，把续发的过滤掉了。。。

lrh788

笨鸟飞不高 发表于 2020-7-18 13:30
代码是有问题，把续发的过滤掉了。。。

我的数据中存在同一人有两次停发，中间并不存在续发，请把此部分人也提取出来，并加以标示

笨鸟飞不高

lrh788 发表于 2020-7-18 13:24
如201112同时停发续发的陈华远等等有近3000人

Sub AwTest()
    Dim i&, r&, j%, DayM%, iStr$, DayStr$, endDay As Date, iDay As Date
    Dim arr, kAr, tAr, d As Object
    Application.ScreenUpdating = False
    Set d = CreateObject("Scripting.Dictionary")
    endDay = "2013-12"
    With Sheets("数据")
        .[a1:f83015].Sort .[a1], , .[c1], , Header:=xlYes
        arr = .[a1].CurrentRegion
        For i = 2 To UBound(arr)
            If CDate(Left(arr(i, 3), 4) & "-" & Right(arr(i, 3), 2)) <= endDay Then
                iStr = arr(i, 1) & "|" & arr(i, 2) & "|" & arr(i, 4)
                d(iStr) = ""
            End If
        Next
        kAr = d.keys: tAr = d.items
        ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2) + 1)
        For i = 2 To UBound(arr)
            If CDate(Left(arr(i, 3), 4) & "-" & Right(arr(i, 3), 2)) <= endDay Then
                iStr = arr(i, 1) & "|" & arr(i, 2) & "|" & "续发"
                If Not d.exists(iStr) Then
                    r = r + 1
                    For j = 1 To UBound(arr, 2)
                        brr(r, j) = arr(i, j)
                    Next
                    DayStr = Left(brr(r, 3), 4) & "-" & Right(brr(r, 3), 2)
                    iDay = CDate(DayStr)
                    DayM = DateDiff("m", iDay, endDay) '相距月数
                    If DayM > 0 Then brr(r, 7) = DayM \ 12 & "年" & DayM Mod 12 & "个月"
                End If
            End If
        Next
    End With
    With Sheets("一直停发")
        .[a1].CurrentRegion.Offset(1) = Empty
        .[a2].Resize(r, 7) = brr
    End With
    Application.ScreenUpdating = True
End Sub

一直停发的代码！！增加开始判断是什么意思？在哪里增加？？

lrh788

笨鸟飞不高 发表于 2020-7-18 13:54
Sub AwTest()
    Dim i&, r&, j%, DayM%, iStr$, DayStr$, endDay As Date, iDay As Date
    Dim arr ...

老师，这个代码取值正确了。但仍请老师再次完善代码，1、我的实际数据有15列，能否在两个代码中改进下，让代码自动判断数据表的有效数据列数宽度和自动获取数据表的标题行数据。并在提取后的数据最后一列加上标题"停发年次"、“停发续发次数”。2、我的数据中存在同一人有两次停发，中间并不存在续发，请把此部分人加以标示。3、请在两个代码中增加开始时间判断，以便我任意选择时间段来提取数据。
另外，停发续发代码，我目前没有发现问题，因我没有正确对比数据。

lrh788

回答又被这审核。。。。。。

lrh788

笨鸟飞不高 发表于 2020-7-18 13:54
Sub AwTest()
    Dim i&, r&, j%, DayM%, iStr$, DayStr$, endDay As Date, iDay As Date
    Dim arr ...

输入选择（停发、续发）数据的起始时间、结束时间，如23楼丸子老师的代码

笨鸟飞不高

lrh788 发表于 2020-7-18 14:23
输入选择（停发、续发）数据的起始时间、结束时间，如23楼丸子老师的代码

有人帮你写了，你就问他吧！可能每个人的思路不同吧，别人的代码懒得去看的

lrh788

笨鸟飞不高 发表于 2020-7-18 15:02
有人帮你写了，你就问他吧！可能每个人的思路不同吧，别人的代码懒得去看的

好的，谢谢老师了，还请老师空时按我35楼的要求完善下代码！

zpy2

lrh788 发表于 2020-7-17 16:07
老师，我的实际数据有15列，能否在一直停发代码中改进下，让代码自动判断数据表的有效数据列数宽度和自 ...

我的实际数据有15列，能否在一直停发代码中改进下，让代码自动判断数据表的有效数据列数宽度和自动获取数据表的标题行数据

这个问题是不是 可以 从15列 抽取 其中的有效 列 形成一个你上传的表的样子的新表，再用楼上的代码筛选。vba 代码的耦合太高，修改可能不易。