查询停发续发情况

lrh788

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

老师，我的数据表的列数不固定，有时是10列，有时是15列等。我想让代码自动判断数据表的列数。

zpy2

lrh788 发表于 2020-7-18 17:48
老师，我的数据表的列数不固定，有时是10列，有时是15列等。我想让代码自动判断数据表的列数。

对的，你的想法是不错的，最好代码的自动化程度能够高一点，使用起来方便一些。
但是，我发现这个查询的代码还是比较复杂的，有时候可能只能折中一下。
另外，你的连续停发，是不是包括全部是停发的，4年里停放3次的情况，4年里停发2次（这种再进行筛选）
就是说 ，你需要的结果最好具体化。
我这些建议当然是从写代码的人的角度分析的，因为，要写出通用性的全面的解决方案，难度的确不小，需要平衡。

lrh788

谢谢老师的解释！

丸子不是小孩子

lrh788 发表于 2020-7-18 14:17
老师，这个代码取值正确了。但仍请老师再次完善代码，1、我的实际数据有15列，能否在两个代码中改进下， ...

你把15列数据发个样表上来看看，停发\续发 列是固定的还是不固定的？

丸子不是小孩子

已更新代码，更新代码在模块2，原代码保留在模块1，更新内容
1、统计起止年月合并在同一输入框
2、除ABC列内容固定，自动查找 停发\续发 所在列，自动识别数据列数
3、部分细节调整。。。

笨鸟飞不高

lrh788 发表于 2020-7-18 14:17
老师，这个代码取值正确了。但仍请老师再次完善代码，1、我的实际数据有15列，能否在两个代码中改进下， ...

Sub AwTest()
Dim i&, r&, j%, DayM%, iStr$, DayStr$, begDay$, endDay$, iDay As Date
    Dim arr, d As Object
    Application.ScreenUpdating = False
    Set d = CreateObject("Scripting.Dictionary")
    begDay = InputBox("请输入开始日期，格式如：202001")
    If StrPtr(begDay) = 0 Then Exit Sub
    endDay = InputBox("请输入结束日期，格式如：202001")
    If StrPtr(endDay) = 0 Then Exit Sub
    With Sheets("数据")
        arr = .[a1].CurrentRegion
        For i = 2 To UBound(arr)
            If arr(i, 3) >= begDay And arr(i, 3) <= endDay Then
                iStr = arr(i, 1) & "|" & arr(i, 2) & "|" & arr(i, 4)
                d(iStr) = ""
            End If
        Next
        ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2) + 1)
        For j = 1 To UBound(arr, 2)
            brr(1, j) = arr(1, j)
        Next
        brr(1, UBound(brr, 2)) = "停发年次"
        r = 1
        For i = 2 To UBound(arr)
            If arr(i, 3) >= begDay And arr(i, 3) <= 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, CDate(Left(endDay, 4) & "-" & Right(endDay, 2)))
                    If DayM > 0 Then brr(r, 7) = DayM \ 12 & "年" & DayM Mod 12 & "个月"
                End If
            End If
        Next
    End With
    With Sheets("一直停发")
        .Cells.Clear
        If r > 0 Then
            .[a1].Resize(r, UBound(brr, 2)) = brr
        End If
    End With
    Application.ScreenUpdating = True
End Sub

一直停发代码！增加开始日期判断，数据列不固定，是这意思吗？

笨鸟飞不高

停发或续发人员效果.rar (1.54 MB, 下载次数: 4)

2020-7-19 00:35 上传

点击文件名下载附件

没附件效果！只好再次猜！！！

lrh788

丸子不是小孩子 发表于 2020-7-19 00:09
已更新代码，更新代码在模块2，原代码保留在模块1，更新内容
1、统计起止年月合并在同一输入框
2、除ABC ...

谢谢老师的帮助，你的新一直停发代码已完全符合要求了。还请写下停发续发代码。

lrh788

笨鸟飞不高 发表于 2020-7-19 00:36
没附件效果！只好再次猜！！！

谢谢笨鸟飞不高 老师的帮助，你的代码已基本符合要求了，只是对同一人存在多次停发且未有任何续发的人员没有进行标注，其他的我都能自己调整解决了。

丸子不是小孩子

lrh788 发表于 2020-7-19 06:41
谢谢老师的帮助，你的新一直停发代码已完全符合要求了。还请写下停发续发代码。

哈哈，我看到有人写就不写了