# Re: 如何写出算出某日为星期几? (不使用 WEEKDAY)

Posted by Honey on July 08, 1999 at 07:08:39:

In Reply to: 如何写出算出某日为星期几? (不使用 WEEKDAY) posted by CHEN on July 07, 1999 at 08:00:43:

: 如何写出算出某日为星期几, 是否有什么公式可算出? (不使用 WEEKDAY)

这个问题我蛮喜欢的 不过蛮烦的
我知道这有现成的公式 一时也找不到
我是从定义去推
这个问题比较难的部分是有闰月的时候
已知
/*1981年2月5日是星期四*/<-这是Honey的生日 要记的

闰年的定义是/*
年份能被4整除的为闰年
但这年若能被4也能被100整除 不为闰年
若能被100也能被200整除 这是闰年*/

有这两个定义 就能推出星期

由闰年的定义可知
在年的个位及十位不为零的时候
十位个位若能被4整除 这年是闰年
若在年的个位及十位不为零的时候
若百位是2,4,6,8,0时是闰年 否则便不是
于是便可定义以下函数

'/**********************************************************************
Public Function ChYears(LngYears As Long) As Boolean'/*传回Ture表闰年*/
'/*LngYears表年*/
Dim BytMY As Byte
BytMY = LngYears Mod 100'/*个位及十位数字*/
If BytMY Then '/*不等于0*/
If BytMY Mod 4 = 0 Then
ChYears = True'/*能被4整除为润*/
Else
ChYears = False'/*否则便不是*/
End If
Else'/*个位及十位数字等于零(能被100整除)*/
If LngYears Mod 200 = 0 Then
ChYears = True'/*能被200整除为润*/
Else
ChYears = False'/*否则不是*/
End If
End If
End Function
'**********************************************************************/
用上述判断法则知 1981 1982 1983都不是闰年 有365天
又365 mod 7 = 1 代表每加一年星期也得加1

1984年是闰年 有366天
又366 mod 7 = 2 代表每加一年星期也得加2

即1981年2月5日星期四 =>1982年2月5日星期五(因为1981不是闰年 加1)
即1982年2月5日星期五 =>1983年2月5日星期六(因为1982不是闰年 加1)
即1983年2月5日星期六 =>1984年2月5日星期日(因为1983不是闰年 加1)
即1984年2月5日星期日 =>1985年2月5日星期二(因为1984是闰年 加2)
要注意的是闰年加2反映在下一年
这样便很容易推出2000年2月5日是星期几

假设今天是2000年3月16日

设0代表星期日
1代表星期一
:
:
6代表星期六
把上式写成
'/*******************************************************************************
Public Function IntWeek(LngYears As Long) As Integer'/*传回LngYears年二月五日是星期几*/
Dim LngYSp As Long'/*用于for的指标*/
IntWeek = 4'/*1981年2月5日是星期四*/
If LngYears > 1981 Then'/*年份大于1981*/
For LngYSp = 1982 To LngYears
If ChYears(LngYSp - 1) Then'/*是闰年*/
IntWeek = IntWeek + 2'/*闰年加二*/
IntWeek = ChWeek(IntWeek)'/*呼叫自订函数将这个值介于0~7之间*/
Else'/*不是闰年*/
IntWeek = IntWeek + 1'/*非闰年加1*/
IntWeek = ChWeek(IntWeek)'/*呼叫自订函数将这个值介于0~7之间*/
End If
Next

ElseIf LngYears = 1981 Then'/*刚好是1981年*/
IntWeek = 4
Else
For LngYSp = 1980 To LngYears Step -1'/*年份小于1981年*/
If ChYears(LngYSp) Then'/*注意从1980年开始*/
IntWeek = IntWeek - 2'/*闰年减二*/
IntWeek = ChWeek(IntWeek) Mod 7'/*呼叫自订函数将这个值介于0~6之间*/
Else
IntWeek = IntWeek - 1'/*非闰年减一*/
IntWeek = ChWeek(IntWeek) Mod 7'/*呼叫自订函数将这个值介于0~6之间*/
End If
Next
End If
End Function

Public Function ChWeek(IntWeek As Integer) As Byte'/*自订更正函数*/
While IntWeek < 0'/*若小于零加到大于等于零*/
IntWeek = IntWeek + 7
Wend

If IntWeek > 7 Then
IntWeek = IntWeek Mod 7'/*始介于0~6之间*/
End If

ChWeek = IntWeek'/*传回这个值*/
End Function
'*******************************************************************************/
呼叫IntWeek(N) 传回 N年2月5日星期几
碰巧2月5日在月29日之前
另外由观察可得另一种规律(因为每月日数固定)
若今年是闰年月份星期的差是
(规律1)
1 -> 4
2 -> 0
3 -> 1
4 -> 4
5 -> 6
6 -> 2
7 -> 4
8 -> 0
9 -> 3
10-> 5
11-> 1
12-> 3
若今年非闰年月份星期的差是
(规律2)
1 -> 4
2 -> 0
3 -> 0
4 -> 3
5 -> 5
6 -> 1
7 -> 3
8 -> 6
9 -> 2
10-> 4
11-> 0
12-> 2

上述方法已推出2000年二月5日星期六
又2000年是闰年 三月得加一 得7
即2000年3月5日星期日
日期是16日 16-5=11
(11+7) MOD 7 得 4
即2000年3月16日星期四
换算法如下
'/**********************************************************
Public Function BytMO(LngYears As Long, BytMonth As Byte, BytWeek As Byte) As Byte
'/*传回LngYears年BytMonth月5日星期几 BytWeek为函数IntWeek传回值*/
If ChYears(LngYears) Then
Select Case BytMonth'/*闰年时*/
Case 1, 4, 7'/*1, 4, 7月时和二月差 4 (规律1)*/
BytMO = ChWeek(BytWeek + 4)'/*加4后将值定于0~6之间*/
Case 2, 8'/*2, 8月时和二月差零(规律1)*/
BytMO = BytWeek'/*将值定于0~6之间*/
Case 3, 11'/*3, 11月时和二月差1 (规律1)*/
BytMO = ChWeek(BytWeek + 1)'/*加1后将值定于0~6之间*/
Case 5'/* 5月时和二月差6 (规律1)*/
BytMO = ChWeek(BytWeek + 6)'/*加6后将值定于0~6之间*/
Case 6'/* 6月时和二月差2(规律1)*/
BytMO = ChWeek(BytWeek + 2)'/*加2后将值定于0~6之间*/
Case 9, 12'/*9, 12月时和二月差3(规律1)*/
BytMO = ChWeek(BytWeek + 3)'/*加3后将值定于0~6之间*/
Case 10'/*10月时和二月差5(规律1)*/
BytMO = ChWeek(BytWeek + 5)'/*加5后将值定于0~6之间*/
Case Else
End Select
Else
Select Case BytMonth'/*非闰年*/
Case 1, 10'/* 1, 10月时和二月差 4 (规律2)*/
BytMO = ChWeek(BytWeek + 4)'/*加4后将值定于0~6之间*/
Case 2, 3, 11'/* 2, 3, 11月时和二月差0 (规律2)*/
BytMO = BytWeek'/*将值定于0~6之间*/
Case 4, 7'/* 4, 7月时和二月差 3 (规律2)*/
BytMO = ChWeek(BytWeek + 3)'/*加3后将值定于0~6之间*/
Case 5'/* 5月时和二月差 5 (规律2)*/
BytMO = ChWeek(BytWeek + 5)'/*加5后将值定于0~6之间*/
Case 6'/* 6月时和二月差 1 (规律2)*/
BytMO = ChWeek(BytWeek + 1)'/*加1后将值定于0~6之间*/
Case 8'/* 8月时和二月差 6 (规律2)*/
BytMO = ChWeek(BytWeek + 6)'/*加6后将值定于0~6之间*/
Case 9, 12'/* 9, 12月时和二月差 2 (规律2)*/
BytMO = ChWeek(BytWeek + 2)'/*加2后将值定于0~6之间*/
Case Else
End Select
End If

End Function

Public Function BytDay(BytdaYs As Byte, BytWeek As Byte) As Byte'/*传回介于0~6的值*/
BytDay = ChWeek(BytdaYs - 5 + BytWeek)
End Function
'*********************************************************************/
先呼叫BytMO(N,h,k)传回n年h月5日是星期几(K指N年2月5日星期几)
将这个值U 传给BytDay(T,U)传回值即为所求(T指N日)

统合以上函数 可以这样合成一个函数
'*************************************************************************************
Public Function GetNowWeek(LngYear As Long, BytMonth As Byte, BytDays As Byte) As Byte
Dim BytNowWeek As Byte
BytNowWeek = IntWeek(LngYear)
BytNowWeek = BytMO(LngYear, BytMonth, BytNowWeek)
BytNowWeek = BytDay(BytDays, BytNowWeek)
GetNowWeek = BytNowWeek
End Function
'**************************************************************************************
只要呼叫s=GetNowWeek(2010,8,24) 即可传回2010年8月24日星期s

Follow Ups:

- 定义错误 Honey 17:37:31 7/09/99 (1)
  - 谢谢您的说明 CHEN 12:21:08 7/13/99 (0)