计算日期为当年的第几周(vbscript 可以定义为excel函数)

和上一篇的javascript是一样的算法

***********VbScript************

Function mweek(datestr As Date) As String
'zhangsen foxconn 2008-05
Dim strdate
strdate = datestr
Dim pweek, numdate, nowyear, nowmonth, firstdate, lastday, weeknum, upstrdate
numdate = Day(strdate)
nowyear = Year(strdate)
nowmonth = Month(strdate)
firstdate = DateValue(nowyear & "-" & nowmonth & "-" & "1")
'ff = MsgBox(Weekday(firstdate), vbOKOnly)
If Weekday(firstdate) < 6 And Weekday(firstdate) <> 1 Then
firstdate = firstdate - Weekday(firstdate) + 1
'ff = MsgBox(firstdate & "a", vbOKOnly)
Else
If Weekday(firstdate) = 1 Then
firstdate = firstdate
' ff = MsgBox(firstdate & "b", vbOKOnly)
Else
firstdate = firstdate + (7 - Weekday(firstdate)) + 1
' ff = MsgBox(firstdate & "C", vbOKOnly)
End If
End If
'ff = MsgBox(firstdate, vbOKOnly)
If nowmonth = 12 Then
lastdate = DateValue(nowyear + 1 & "-" & "1" & "-" & "1") - 1
Else
lastdate = DateValue(nowyear & "-" & nowmonth + 1 & "-" & "1") - 1
End If
'ff = MsgBox(firstdate, vbOKOnly)
weeknum = Int((strdate - firstdate - 1) / 7) + 1
'ff = MsgBox(weeknum, vbOKOnly)
If nowmonth < 10 Then
pweek = "M0" & (nowmonth) & "W" & weeknum
Else
pweek = "M" & (nowmonth) & "W" & weeknum
End If
If nowmonth < 10 Then
anowmonth = "0" + nowmonth
Else
anowmonth = nowmonth
End If
'ff = MsgBox(weeknum, vbOKOnly)
'ff = MsgBox(nowmonth, vbOKOnly)
If weeknum = 0 And nowmonth <> 0 Then
If nowmonth = 0 Then
upstrdate = DateValue(nowyear + 1 & "-" & "1" & "-" & "1") - 1
Else
upstrdate = DateValue(nowyear & "-" & nowmonth & "-" & "1") - 1
End If
'ff = MsgBox(shipMonth2(upstrdate), vbOKOnly)
If shipMonth2(upstrdate) = 5 Then

If Weekday(strdate) < 6 And Weekday(strdate) <> 1 And (nowmonth) < 10 Then

If (nowmonth) = 1 Then
pweek = "M12" & "W5"
Else
If (nowmonth) = 1 Then
pweek = "M12" & "W5"
Else

pweek = "M0" & (nowmonth - 1) & "W5"
End If
End If
Else

If (Weekday(strdate) > 5 Or Weekday(strdate) = 1) And (nowmonth) < 10 Then


If (nowmonth) = 1 Then
pweek = "M12" & "W5"
Else

pweek = "M0" & (nowmonth - 1) & "W5"

End If

Else

If (Weekday(strdate) > 5 Or Weekday(strdate) = 1) And (nowmonth) > 10 Then
If Weekday(strdate) = 1 Then
pweek = "M" & (nowmonth - 1) & "W5"
Else
pweek = "M" & (nowmonth - 1) & "W5"

End If

Else

pweek = "M0" & (nowmonth - 1) & "W5"

End If
End If
End If
Else

If Weekday(strdate) < 6 And Weekday(strdate) <> 1 Then
If (nowmonth) = 1 Then
pweek = "M12" & "W5"
Else
If (nowmonth) < 11 Then
pweek = "M0" & (nowmonth - 1) & "W4"
Else
pweek = "M" & (nowmonth - 1) & "W5"
End If
End If
Else

' ff = MsgBox(Weekday(strdate), vbOKOnly)
If (nowmonth) = 1 Then
pweek = "M12" & "W5"
Else

If (nowmonth) > 10 Then
pweek = "M" & (nowmonth - 1) & "W4"
Else
pweek = "M0" & (nowmonth - 1) & "W4"
End If
End If


End If
End If
End If
If weeknum = 0 And nowmonth = 0 Then
upstrdate = DateValue(nowyear - 1 & "-" & "12" & "-" & "31")
If shipMonth2(upstrdate) = 5 Then
If nowmonth < 10 Then
pweek = "M0" & Month(upstrdate) & "W5"
Else
pweek = "M" & Month(upstrdate) & "W5"

End If

Else
If (nowmonth) < 10 Then
pweek = "M0" & Month(upstrdate) & "W5"

Else

pweek = "M" & Month(upstrdate) & "W5"
End If
End If
End If
If weeknum > 4 Then
If Weekday(lastdate) > 4 Then
' ff = MsgBox(nowmonth, vbOKOnly)
weeknum = 5
If (nowmonth) < 10 Then
pweek = "M0" & (nowmonth) & "W" & weeknum
Else
pweek = "M" & (nowmonth) & "W" & weeknum
End If
Else
'ff = MsgBox(Weekday(lastdate), vbOKOnly)
' ff = MsgBox(nowmonth, vbOKOnly)
If nowmonth < 10 Then
If nowmonth < 9 Then
pweek = "M0" & (nowmonth + 1) & "W1"
Else
pweek = "M" & (nowmonth + 1) & "W1"
End If
Else
If nowmonth = 11 Then
pweek = "M12" & "W1"
Else
If nowmonth = 12 Then
pweek = "M01" & "W1"
Else
If nowmonth = 10 Then
pweek = "M" & (nowmonth + 1) & "W1"
Else
pweek = "M" & (nowmonth + 1) & "W1"
End If
End If
End If
End If
End If
End If
mweek = pweek
End Function
Function shipMonth2(datestr) As Integer
Dim strdate, pweek
strdate = datestr
'ff = MsgBox(strdate, vbOKOnly)
nowyear = Year(strdate)
nowmonth = Month(strdate)
nowday = Day(strdate)
If nowmonth = 1 Then
firstdate = DateValue(nowyear - 1 & "-" & "12" & "-" & "1")
Else
firstdate = DateValue(nowyear & "-" & nowmonth & "-" & "1")
End If
If Weekday(firstdate) < 6 And Weekday(firstdate) <> 1 Then
firstdate = firstdate - Weekday(firstdate) + 1
Else
If Weekday(firstdate) = 1 Then
firstdate = firstdate
Else
firstdate = firstdate + (7 - Weekday(firstdate)) + 1
End If
End If
'ff = MsgBox(firstdate, vbOKOnly)
'ff = MsgBox(strdate, vbOKOnly)
weeknum = Int((strdate - firstdate - 1) / 7) + 1

If weeknum < 10 And weeknum <> 0 Then
pweek = weeknum
Else
pweek = weeknum
End If
If weeknum = 0 Then
pweek = 5
End If
If weeknum > 4 Then
If Weekday(lastday) > 4 Then
weeknum = 5
pweek = weeknum

Else
pweek = 1

End If
End If

shipMonth2 = pweek
End Function


Function yweek(datestr As Date)
'zhangsen foxconn 2008-03
Dim firstday, firstmonth, nowyear, mylastdate
Dim lastday, lastmonth, lastdate
datestr = datestr
nowyear = Year(datestr)
firstmonth = 1
firstday = 1
firstdate = DateValue(nowyear & "-" & firstmonth & "-" & firstday)


If Weekday(firstdate) < 6 And Weekday(firstdate) <> 1 Then

firstdate = firstdate - Weekday(firstdate) + 1

Else
If Weekday(firstdate) = 1 Then

firstdate = firstdate

Else

firstdate = firstdate + 7 - Weekday(firstdate) + 1

End If

End If
lastday = 31
lastmonth = 12

lastdate = DateValue(nowyear & "-" & lastmonth & "-" & lastday)

weeknum = Int((datestr - firstdate - 1) / 7) + 1


If weeknum < 10 And weeknum <> 0 Then

shipweek = "Y" & nowyear & "W0" & weeknum

Else

shipweek = "Y" & nowyear & "W" & weeknum
End If

If weeknum = 0 Then
lastyear = nowyear - 1
mylastdate = DateValue(lastyear & "-" & lastmonth & "-" & lastday)

If ymweek2(mylastdate) = 53 Then

shipweek = "Y" & nowyear - 1 & "W53"

Else
shipweek = "Y" & nowyear - 1 & "W52"
End If

End If

If weeknum > 52 Then

If Weekday(lastdate) > 4 Then

weeknum = 53

shipweek = "Y" & nowyear & "W" & weeknum


Else
shipweek = "Y" & (nowyear + 1) & "W01"

End If

End If
yweek = shipweek
End Function

Function ymweek2(datestr) As Integer

Dim firstday, firstmonth, nowyear
Dim lastday, lastmonth, lastdate
datestr = datestr
nowyear = Year(datestr)
firstmonth = 1
firstday = 1
firstdate = DateValue(nowyear & "-" & firstmonth & "-" & firstday)

If Weekday(firstdate) < 6 And Weekday(firstdate) <> 1 Then

firstdate = firstdate - Weekday(firstdate) + 1
Else
If Weekday(firstdate) = 1 Then

firstdate = firstdate

Else

firstdate = firstdate + 7 - Weekday(firstdate) + 1

End If
End If
lastday = 31
lastmonth = 12


weeknum = Int((datestr - firstdate - 1) / 7) + 1


If weeknum < 10 And weeknum <> 0 Then
shipweek = weeknum
Else
shipweek = weeknum

End If
If weeknum = 0 Then
shipweek = 53
End If

If weeknum > 52 Then
If Weekday(datestr) > 4 Then

weeknum = 53
shipweek = weeknum

Else
shipweek = 1


End If

End If


ymweek2 = shipweek
End Function

*/
  • 0
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值