当前位置: 代码迷 >> vbScript >> 计算日期替当年的第几周(vbscript 可以定义为excel函数)
  详细解决方案

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

热度:698   发布时间:2012-12-25 16:18:29.0
计算日期为当年的第几周(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

*/

  相关解决方案