如果你认为下图中的日期为 第二周 的话,试试这些代码:
Option Compare Database
Dim c As Integer
Dim d As Date
Sub get_weekcount_weekday()
Dim a As Integer
Dim b As Date
On Error GoTo inputbox_Err
d = InputBox("形如2000-01-01", "输入日期")
a = Month(d)
Select Case a
Case 1
b = #1/1/2006#
c = Abs(d - b)
Debug.Print c '距离某月第一天的天数
Case 2
b = #2/1/2006#
c = Abs(d - b)
Case 3
b = #3/1/2006#
c = Abs(d - b)
Case 4
b = #4/1/2006#
c = Abs(d - b)
Case 5
b = #5/1/2006#
c = Abs(d - b)
Case 6
b = #6/1/2006#
c = Abs(d - b)
Case 7
b = #7/1/2006#
c = Abs(d - b)
Case 8
b = #8/1/2006#
c = Abs(d - b)
Case 9
b = #9/1/2006#
c = Abs(d - b)
Case 10
b = #10/1/2006#
c = Abs(d - b)
Case 11
b = #11/1/2006#
c = Abs(d - b)
Case 12
b = #12/1/2006#
c = Abs(d - b)
End Select
Call weekcount
inputbox_Exit:
Exit Sub
inputbox_Err:
'MsgBox Error$
MsgBox "1、您输入的日期格式错误" & vbCr & "" & vbCr & "2、或者取消了日期输入", vbInformation, "日期输入提示..."
Resume inputbox_Exit
Exit Sub
End Sub
Sub weekcount()
Select Case c
Case 0, 1, 2, 3, 4, 5
MsgBox "第一周"
MsgBox "星期" & Weekday(d, vbMonday) '把每周一作为每周的第一天
Case 6, 7, 8, 9, 10, 11
MsgBox "第二周"
MsgBox "星期" & Weekday(d, vbMonday)
Case 12, 13, 14, 15, 16, 17
MsgBox "第三周"
MsgBox "星期" & Weekday(d, vbMonday)
Case Is > 18
MsgBox "第四周"
MsgBox "星期" & Weekday(d, vbMonday)
End Select
end sub
调用:call get_weekcount_weekday()
上述代码计算 2006-06-14 为第三周,注意只能计算2006年度。写得更通用一点,我无力完成。
[此贴子已经被作者于2006-6-13 19:49:54编辑过]
|