計算出兩個日期之間為第幾星期

[jxxiongxujun]

要計算出兩個日期之間為第幾星期如:
200808011至20080817
為8月份的第一星期

[jxxiongxujun]

還有我要將兩個日期合二為一，不要分開的，先謝過

[fvflove]

晕.楼上的怎么不行了?
我看就行.一周是七天啊.(他的一周指从周一至周日)

比如:
2008/08/11 是第二周
2008/08/17 是第二周

2008/08/18 是第三周


2008/07/08 是第一周 '是七月份的第一周

[jxxiongxujun]

對啊是周一至周日
也許我沒說明白，
我的兩個日期分別會是：
起始日期：一定是星期一
終止日期:一定是星期日
還有我要將它二合一，但是我不會所以希望大家幫我的忙，謝了

[fvflove]

Option Explicit

Private Sub Command1_Click()
  Dim a() As Date
  a = cWeekDate(2008, 52)
  MsgBox a(0) '2008年第52周的起始日
  MsgBox a(1) '2008年第52周的终止日

  a = cWeekDate(2008, 2,8)
  MsgBox a(0) '2008年8月份第2周起始日
  MsgBox a(1) '2008年8月份第2周终止日

End Sub


Public Function cWeekDate(ByVal cYear As Long, cWeek As Long, Optional ByVal cMonth As Long) As Date()
   Dim vDate(1) As Date
   Dim cDay As Long
   cWeekDate = vDate
   '每个月的第一周为满周.第一天为周一，最后一天为周日
  '不设定cMouth 的值，或值等于0 则返回的是以年为单位的周。
  ' 比如： cWeekDate(2008,13,0) 或 cweekdate(2008,13) 返回的是2008年的第十三周的起始及终止日
  ' 比如： cWeekDate(2008,1,8) 返回的是2008年8月份的第1周的起始及终止日
  ' 
  If cWeek < 1 Then Exit Function
  
  If cMonth > 0 And cMonth < 13 Then
     If Weekday(cYear & "/" & cMonth & "/01") > 2 Then
        cDay = (9 - Weekday(cYear & "/" & cMonth & "/01")) + (cWeek - 1) * 7
        vDate(0) = DateAdd("d", cDay, cYear & "/" & cMonth & "/01")
        If Month(vDate(0)) <> cMonth Then
           Exit Function
        End If
        vDate(1) = DateAdd("d", 7, vDate(0))
     End If
  Else
    If Weekday(cYear & "/01/01") > 2 Then
       cDay = (9 - Weekday(cYear & "/01/01")) + (cWeek - 1) * 7
       vDate(0) = DateAdd("d", cDay, cYear & "/01/01")
       If Year(vDate(0)) <> cYear Then
          Exit Function
       End If
       vDate(1) = DateAdd("d", 7, vDate(0))
    End If
  End If
  cWeekDate = vDate
End Function

[jxxiongxujun]

不好意思我還是沒有搞定，能不能幫我寫一個完整的
控件為command1,DTPicker1,DTPicker2,還要根據這所得出來得日期分組數據
謝謝

[ftz820127]

Private Sub Command1_Click()
    Dim date1 As Date
    Dim date2 As Date
    
    date1 = DTPicker1.Value
    date2 = DTPicker2.Value
    Debug.Print "日期一为第：" & DateDiff("ww", Year(date1) & "-" & Month(date1) & "-01", date1, vbMonday, vbFirstJan1) & "周"
    Debug.Print "日期二为第：" & DateDiff("ww", Year(date2) & "-" & Month(date2) & "-01", date2, vbMonday, vbFirstJan1) & "周"

End Sub

Private Sub Form_Load()
    DTPicker1.Value = "2008-08-18"
    DTPicker2.Value = "2008-08-24"
End Sub

[ftz820127]

如果你确定两个日期是在同一个星期里的那就把
Debug.Print "日期一为第：" & DateDiff("ww", Year(date1) & "-" & Month(date1) & "-01", date1, vbMonday, vbFirstJan1) & "周"
Debug.Print "日期二为第：" & DateDiff("ww", Year(date2) & "-" & Month(date2) & "-01", date2, vbMonday, vbFirstJan1) & "周"
这两句改成
Debug.Print "日期为第：" & DateDiff("ww", Year(date1) & "-" & Month(date1) & "-01", date1, vbMonday, vbFirstJan1) & "周"
这一句就够了
还有系统默认星期是从星期天开始到星期六的，所以你的不行可能就是这个原因造成的自己看看吧这段代码应该是没问题的

[jxxiongxujun]

這樣做得話如果它是跨越月份就不行啊
比如說：20080728至200807803

[jxxiongxujun]

大家再幫下忙

[fvflove]

晕。你有没有试过用一下我的代码？
会不行吗？

[啊的发哦]

[Quote=引用 11 楼 ftz820127 的回复:]
VB code
Private Sub Command1_Click()
Dim date1 As Date
Dim date2 As Date

date1 = DTPicker1.Value
date2 = DTPicker2.Value
Debug.Print "日期一为第：" & DateDiff("ww", Year(date1) & "-" & Month(date1) & "-01", date1, vbMonday, vbFirstJan1) & "周"
Debug.Print "日期二为第：" & DateDiff("ww", Year(date2) & "-" & Month(date2) & "-01", date2, vbMonday, vbFirstJan1) &…
[/Quote]
跨月的自己做个条件吗,关键的都给你了!

[jxxiongxujun]

還是沒搞定，過一個小時結貼，望朋友幫忙

[ftz820127]

    Dim date1 As Date
    Dim date2 As Date
    Dim tempdate As Date
    Dim week1 As Long
    Dim week2 As Long
    Dim weeks As Long
    Dim i As Long
    
    Text1.Text = ""
    date1 = DTPicker1.Value
    date2 = DTPicker2.Value
    week1 = DateDiff("ww", Year(date1) & "-" & Month(date1) & "-01", date1, vbMonday, vbFirstJan1) + 1
    week2 = DateDiff("ww", Year(date2) & "-" & Month(date2) & "-01", date2, vbMonday, vbFirstJan1) + 1
    weeks = DateDiff("ww", date1, date2)
    Text1.Text = Text1.Text & "日期一为" & Month(date1) & "月第：" & week1 & "周" & vbCrLf
    Text1.Text = Text1.Text & "日期二为" & Month(date2) & "月第：" & week2 & "周" & vbCrLf
    Text1.Text = Text1.Text & "日期一与日期二相隔：" & weeks & "周" & vbCrLf
    For i = 0 To weeks - 1
        tempdate = DateAdd("ww", i, date1)
        Text1.Text = Text1.Text & Month(tempdate) & "月的第" & DateDiff("ww", Year(tempdate) & "-" & Month(tempdate) & "-01", tempdate, vbMonday, vbFirstJan1) + 1 & "周" & vbCrLf
    Next

你拿去试试吧

[jxxiongxujun]

還是不對
如果日期為:20080804至20080824
結果應該分別為:
第二周
第三周
還是要二合一

[ftz820127]

    Dim date1 As Date
    Dim date2 As Date
    Dim tempdate As Date
    Dim week1 As Long
    Dim week2 As Long
    Dim weeks As Long
    Dim i As Long
    
    Text1.Text = ""
    date1 = DTPicker1.Value
    date2 = DTPicker2.Value
    week1 = DateDiff("ww", Year(date1) & "-" & Month(date1) & "-01", date1, vbMonday, vbFirstJan1) + 1
    week2 = DateDiff("ww", Year(date2) & "-" & Month(date2) & "-01", date2, vbMonday, vbFirstJan1)
    weeks = DateDiff("ww", date1, date2) - 1
    Text1.Text = Text1.Text & "日期一为" & Month(date1) & "月第：" & week1 & "周" & vbCrLf
    Text1.Text = Text1.Text & "日期二为" & Month(date2) & "月第：" & week2 & "周" & vbCrLf
    Text1.Text = Text1.Text & "日期一与日期二相隔：" & weeks & "周" & vbCrLf
    For i = 0 To weeks - 1
        tempdate = DateAdd("ww", i, date1)
        Text1.Text = Text1.Text & Month(tempdate) & "月的第" & DateDiff("ww", Year(tempdate) & "-" & Month(tempdate) & "-01", tempdate, vbMonday, vbFirstJan1) + 1 & "周" & vbCrLf
    Next

[ftz820127]

[Quote=引用 21 楼 jxxiongxujun 的回复:]
還是不對
如果日期為:20080804至20080824
結果應該分別為:
第二周
第三周
還是要二合一
[/Quote]

真是搞不懂明明是3周的为什么你要算成2周
4－10 1周
11－17 2周
18－24 3周

你是怎么算出来只要2周的？
还有二合一是什么意思？把字符串合起来?

[jxxiongxujun]

哦是我算錯了，不好意思啊
我是要是的

[jxxiongxujun]

謝了，不過我還沒有解決

[jxxiongxujun]

[Quote=引用 15 楼 fvflove 的回复:]
晕。你有没有试过用一下我的代码？
会不行吗？
[/Quote]
嗯，試了

[jxxiongxujun]

[Quote=引用 16 楼 shendun2007 的回复:]
引用 11 楼 ftz820127 的回复:
VB code
Private Sub Command1_Click()
Dim date1 As Date
Dim date2 As Date

date1 = DTPicker1.Value
date2 = DTPicker2.Value
Debug.Print "日期一为第：" & DateDiff("ww", Year(date1) & "-" & Month(date1) & "-01", date1, vbMonday, vbFirstJan1) & "周"
Debug.Print "日期二为第：" & DateDiff("ww", Year(date2) & "-" & Month(date2) & "…
[/Quote]
還有啊，這樣的話如果我選得是相隔兩個星期會是第四周，應該是第一周，第二周，第三周，第四周的