打开工作簿自动分类弹出提示

AFree123

打开工作簿自动分类弹出提示

1、数据很多，当前仅是列举部分

2、姓名在B列，日期在G列

3、打开工作簿时，自动弹出提示

4、自动弹出提示显示规则

      （1）以前年度的不显示，即2018年以前的不用提示

       （2）以电脑前当前日期为参照，前后10天以内到期的予以提示

                   比如，今天2019-03-14，

                                 2019-3-04   至  2019-3-13  提示“今年合同已到期人员名单”姓名、.......

                                 2019-3-14    提示“今天合同到期人员名单”姓名、.......

                                 2019-3-15   至  2019-3-24  提示“今年合同即将到期人员名单”姓名、.......

      （3）如果以上3类都存在，就依次弹出第一个提示，待人工点击“确定”，就关闭；

                   接着弹出第二个提示，待人工点击“确定”，就关闭；

                   接着弹出第三个提示，，待人工点击“确定”，就关闭。

请大神帮帮忙，谢谢！

唐朝123

见附件，看下是否你想要的。

AFree123

唐朝123 发表于 2019-3-14 20:14
见附件，看下是否你想要的。

谢谢老师的帮助！
再请教老师，可否使用CDate进行计算天数？好像跨月的不行呀

唐朝123

AFree123 发表于 2019-3-14 20:51
谢谢老师的帮助！
再请教老师，可否使用CDate进行计算天数？好像跨月的不行呀

CDATE函数只是转化成日期格式，而DATEDIFF是计算两个日期的间隔天数的，跨月、年都没问题。

AFree123

唐朝123 发表于 2019-3-14 21:26
CDATE函数只是转化成日期格式，而DATEDIFF是计算两个日期的间隔天数的，跨月、年都没问题。

谢谢老师指点！

APPLE123

AFree123 发表于 2019-3-14 20:51
谢谢老师的帮助！
再请教老师，可否使用CDate进行计算天数？好像跨月的不行呀

试试这个
Private Sub Workbook_Open()
    r = Cells(Rows.Count, "G").End(3).Row
    str1 = "近期合同已到期人员名单："
    str2 = "今天合同到期人员名单："
    str3 = "近期合同即将到期人员名单："
    With Sheets(1)
        For j = 3 To r
            If Year(.Cells(j, "G").Value) = Year(Now) Then
                   If Date - CDate(.Cells(j, "G").Value) > 0 And Date - CDate(.Cells(j, "G").Value) < 10 Then
                       str1 = str1 & Chr(10) & .Cells(j, 2) & "-" & .Cells(j, "G")
                   End If
                   If Date - CDate(.Cells(j, "G").Value) = 0 Then
                       str2 = str2 & Chr(10) & .Cells(j, 2) & "-" & .Cells(j, "G")
                   End If
                   If CDate(.Cells(j, "G").Value) - Date > 0 And CDate(.Cells(j, "G").Value) - Date < 10 Then
                       str3 = str3 & Chr(10) & .Cells(j, 2) & "-" & .Cells(j, "G")
                   End If
            End If
        Next j
    End With
    If InStr(str1, Chr(10)) > 0 Then MsgBox str1
    If InStr(str2, Chr(10)) > 0 Then MsgBox str2
    If InStr(str3, Chr(10)) > 0 Then MsgBox str3
End Sub

APPLE123

附件如下，试试看

AFree123

APPLE123 发表于 2019-3-15 12:43
试试这个
Private Sub Workbook_Open()
    r = Cells(Rows.Count, "G").End(3).Row

谢谢老师的帮助

AFree123

APPLE123 发表于 2019-3-15 12:43
试试这个
Private Sub Workbook_Open()
    r = Cells(Rows.Count, "G").End(3).Row

再请教老师，如果一个工作簿内有几个工作表，每个工作表格式一样，可否将几个工作表中符合条件的数据，在打开工作簿时一并予以提示，谢谢！

AFree123

唐朝123 发表于 2019-3-14 20:14
见附件，看下是否你想要的。

再请教老师，如果一个工作簿内有几个工作表，每个工作表格式一样，可否将几个工作表中符合条件的数据，在打开工作簿时一并予以提示，谢谢！