[已解决]自动到期提醒

hwc2ycy

ww176185299 发表于 2014-4-11 17:30
老师你好，使用了这个VBA感觉很不错，请问假如X列为正式合同到期时间、Y列为试用期到期时间，如何实现在同 ...

msgbox的数据可以多行显示呀。
你可以上传你的数据。

shaokui123

ww176185299

hwc2ycy 发表于 2014-4-11 19:21
msgbox的数据可以多行显示呀。
你可以上传你的数据。

我就借用一下楼主的附件吧，需要W、Y列到期同时提醒。
麻烦老师了！

hwc2ycy

ww176185299 发表于 2014-4-12 08:11
我就借用一下楼主的附件吧，需要W、Y列到期同时提醒。
麻烦老师了！

1. Private Sub Workbook_Open()
   
2.     Dim arrName, arrDate
   
3.     Dim iRow As Long, i As Long
   
4.     Dim sName1 As String, sName2 As String
   
5.     Dim dDate As Date
   
6. 
   
7.     iRow = Cells(Rows.Count, "B").End(xlUp).Row
   
8.     arrName = Range("h2:h" & iRow).Value
   
9.     arrDate = Range("v2:y" & iRow).Value
   
10.     For i = 1 To UBound(arrName)
    
11.         dDate = 0
    
12.         If Len(arrDate(i, 2)) Then dDate = DateValue(arrDate(i, 2))
    
13.         If Date < dDate And dDate - Date <= 15 Then
    
14.             sName1 = sName1 & arrName(i, 1) & ":" & dDate & vbCrLf
    
15.         End If
    
16.         dDate = 0
    
17. 
    
18.         If Len(arrDate(i, 4)) Then dDate = DateValue(arrDate(i, 4))
    
19. 
    
20.         If Date < dDate And dDate - Date <= 15 Then
    
21.             sName2 = sName1 & arrName(i, 1) & ":" & dDate & vbCrLf
    
22.         End If
    
23.     Next
    
24. 
    
25.     If Len(sName1) Then
    
26.         MsgBox "合同马上到期人员名单:" & vbCr & sName1
    
27.     End If
    
28.     If Len(sName2) Then
    
29.         MsgBox "试用马上到期人员名单:" & vbCr & sName2
    
30.     End If
    
31. End Sub
    

复制代码

ww176185299

hwc2ycy 发表于 2014-4-12 09:26

版主你好，我用少量数据进行了测试，但发现提示不是很准确，麻烦审查下。
另外提醒能否在同一个对话框中显示？
谢谢！

hwc2ycy

ww176185299 发表于 2014-4-12 14:25
版主你好，我用少量数据进行了测试，但发现提示不是很准确，麻烦审查下。
另外提醒能否在同一个对话框 ...

1. Private Sub Workbook_Open()
   
2.     Dim arrName, arrDate
   
3.     Dim iRow As Long, i As Long
   
4.     Dim sName1 As String, sName2 As String
   
5.     Dim dDate As Date
   
6.    
   
7.     With Sheets("管理人员名册")
   
8.         iRow = .Cells(Rows.Count, "B").End(xlUp).Row
   
9.         arrName = .Range("h2:h" & iRow).Value
   
10.         arrDate = .Range("v2:y" & iRow).Value
    
11.     End With
    
12.    
    
13.     For i = 1 To UBound(arrName)
    
14.         dDate = 0
    
15.         If Len(arrDate(i, 2)) Then dDate = DateValue(arrDate(i, 2))
    
16.         If Date < dDate And dDate - Date <= 15 Then
    
17.             sName1 = sName1 & arrName(i, 1) & ":" & dDate & vbCrLf
    
18.         End If
    
19. 
    
20.         dDate = 0
    
21.         If Len(arrDate(i, 4)) Then dDate = DateValue(arrDate(i, 4))
    
22. 
    
23.         If Date < dDate And dDate - Date <= 15 Then
    
24.             sName2 = sName2 & arrName(i, 1) & ":" & dDate & vbCrLf
    
25.         End If
    
26.     Next
    
27. 
    
28.     MsgBox "合同马上到期人员名单:" & vbCr & sName1 & vbCrLf & "试用马上到期人员名单:" & vbCr & sName2
    
29. End Sub
    

复制代码

sName2里变量名写错了，导致输出显示错误。改好了。

ww176185299

hwc2ycy 发表于 2014-4-12 16:58
sName2里变量名写错了，导致输出显示错误。改好了。

版主好，不好意思又需要求助了！
该表如果U列为员工出生日期，请问如何实现对生日进行提醒？（在同一个msgbox里提醒即可。）
管理人员名册3.rar (12.66 KB, 下载次数: 4)

2014-10-20 16:05 上传

点击文件名下载附件

ww176185299

之前没有想到用辅助列，在vba里折腾“月-日”的比较总是不成功，于是换了一个思路增加一个“生日”的辅助列解决了问题。
不知道版主有没有更好的方法实现？如果有请回复以供学习！谢谢！
管理人员名册4.rar (13.33 KB, 下载次数: 11)

2014-10-21 09:51 上传

点击文件名下载附件