|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
<p>条件太过复杂,普通公式做出来也不容易维护,给你做了一个自定义函数,在E3单元格内输入<br/>=msgr(B3,C3,D3)<br/>其余往下复制即可。</p><p>自定义函数“msgr(级别,性别,出生日期)”的代码如下:</p><p>Option Explicit</p><p>Function msgr(strLevel As String, strGender As String, datBirthday As Date) As String<br/> If Not IsDate(datBirthday) Then<br/> msgr = "出生日期不正确"<br/> Exit Function<br/> End If<br/> <br/> Dim datTemp As Date<br/> Dim intWorkYears As Integer<br/> Dim ntDays As Long, txDays As Long<br/> <br/> datTemp = DateSerial(Year(Date), Month(datBirthday), Day(datBirthday))<br/> If datTemp >= Date Then<br/> intWorkYears = Year(Date) - Year(datBirthday)<br/> Else<br/> intWorkYears = Year(Date) - Year(datBirthday) - 1<br/> End If<br/> <br/> Select Case strGender<br/> Case "男"<br/> Select Case strLevel<br/> Case "工人"<br/> If intWorkYears < 55 Then<br/> ntDays = Date - DateAdd("yyyy", 50, datBirthday)<br/> txDays = Date - DateAdd("yyyy", 55, datBirthday)<br/> Else<br/> ntDays = 0<br/> txDays = Date - DateAdd("yyyy", 55, datBirthday)<br/> End If<br/> Case "干部"<br/> If intWorkYears < 60 Then<br/> ntDays = Date - DateAdd("yyyy", 55, datBirthday)<br/> txDays = Date - DateAdd("yyyy", 60, datBirthday)<br/> Else<br/> ntDays = 0<br/> txDays = Date - DateAdd("yyyy", 60, datBirthday)<br/> End If<br/> Case Else<br/> msgr = "级别无法识别"<br/> Exit Function<br/> End Select<br/> Case "女"<br/> Select Case strLevel<br/> Case "工人"<br/> If intWorkYears < 50 Then<br/> ntDays = Date - DateAdd("yyyy", 45, datBirthday)<br/> txDays = Date - DateAdd("yyyy", 50, datBirthday)<br/> Else<br/> ntDays = 0<br/> txDays = Date - DateAdd("yyyy", 50, datBirthday)<br/> End If<br/> Case "干部"<br/> If intWorkYears < 55 Then<br/> ntDays = Date - DateAdd("yyyy", 50, datBirthday)<br/> txDays = Date - DateAdd("yyyy", 55, datBirthday)<br/> Else<br/> ntDays = 0<br/> txDays = Date - DateAdd("yyyy", 55, datBirthday)<br/> End If<br/> Case Else<br/> msgr = "级别无法识别"<br/> Exit Function<br/> End Select<br/> Case Else<br/> msgr = "性别无法识别"<br/> Exit Function<br/> End Select<br/> <br/> If ntDays > -60 And ntDays < 0 Then<br/> msgr = "还有[" & Abs(ntDays) & "]天内退"<br/> End If<br/> If txDays > -60 And txDays < 0 Then<br/> msgr = "还有[" & Abs(txDays) & "]天退休"<br/> End If<br/> <br/><font color="#5ea25e"> '显示详细情况<br/> 'If ntDays <> 0 Then<br/> ' msgr = "内退(" & ntDays & "天),退休(" & txDays & "天)"<br/> 'Else<br/> ' msgr = "退休(" & txDays & "天)"<br/> 'End If<br/></font>End Function<br/></p>
mQhtXbXK.rar
(10.82 KB, 下载次数: 115)
<br/>
[此贴子已经被作者于2007-9-21 17:04:20编辑过] |
|