100分求一VB函数：返回指定时间段内所有的周、月、季度？

[zsh0809]

求一VB函数：返回指定时间段内所有的周、月、季度，举个例子：
我指定时间段：2009-01-20-------2010-05-09
现在我传入参数（参数作用：指定返回的是周或月或季度），该函数返回这段时间内所有的季度？
请大家帮忙，谢谢

[「已注销」]

自己先做的沙发

[帝企鹅已被占用]

周 用什么方式显示，第一天？

[「已注销」]

[Quote=引用 2 楼 patrickkong 的回复:]
周 用什么方式显示，第一天？
[/Quote]
周的返回样式：如200913 2009表示年份，13表示周别
月的返回样式：如200906 2009表示年份，06表示月份
季度返回样式：如2009Q2 2009表示年份。Q2表示第二季度

[「已注销」]

返回的结果，可以add进comboBox中

[孤独剑_LPZ]

指定时间段,是否是要传入的参数? 问题描述的再清楚点

[「已注销」]

[Quote=引用 5 楼 asftrhgjhkjlkttttttt 的回复:]
指定时间段,是否是要传入的参数? 问题描述的再清楚点
[/Quote]
是要传入参数的，我自己想传入三个参数：开始时间，结束时间，返回类型（判断函数想得到的是周别、月份还是季度）

[of123]

还是不清楚。

你要的是这个期间包含的周数、月数和季度数？还是起始日期是第几周、第几月、第几季度？

如果是前者，怎么叫周别？如果是后者，怎么还需要结束日期？

另外，2009-01-20-------2010-05-09 如何得到 200906 2009表示年份，06表示月份？

[of123]

你会说，我随便举个例子，对吧？

不过，这在咱们这个行业，叫做需求叙述不清。搞软件的，需要严谨。

[帝企鹅已被占用]

这个差不多吧，试试
Private Function dd(startdt As Date, enddate As Date, dttype As Integer) As Collection
Dim col As Collection
Dim dt As Date
Dim strYear As String
Dim strOther As String

Set col = New Collection

dt = startdt

While dt < enddate
strYear = CStr(Year(dt))
Select Case dttype
Case 1 'week
strOther = Format(Format(dt, "ww"), "00")
dt = DateAdd("ww", 1, dt)
Case 2 'month
strOther = Format(Format(dt, "mm"), "00")
dt = DateAdd("m", 1, dt)
Case Else 'year
strOther = Format(Format(dt, "q"), "00")
dt = DateAdd("q", 1, dt)
End Select
col.Add strYear & strOther

MsgBox strYear & strOther
Wend

Set dd = col
End Function

[「已注销」]

[Quote=引用 8 楼 of123 的回复:]
你会说，我随便举个例子，对吧？

不过，这在咱们这个行业，叫做需求叙述不清。搞软件的，需要严谨。
[/Quote]
看来描述的还不够清楚，好的，我说细一些，谢谢提出问题：
Form上的控件：
三个optionButton：分别表示：周别，月份，季度
两个dtpicker：分别指定开始日期和结束日期：
一个comboBox：接受返回值

当optionButton选择的是月份时：则通过函数返回时间段内所包含的所有月份：格式如：200906，additem到comboxBox
类似地，当选择的是周的时候：返回时间段内所包含的所有周：格式化后的样式如：200913，将所有周add进comboBox。
需求就是这样，有什么问题可以提出来，谢谢。

[帝企鹅已被占用]

上面的代码 在跨年时， 最后一周，有问题

[「已注销」]

[Quote=引用 11 楼 patrickkong 的回复:]
上面的代码 在跨年时， 最后一周，有问题
[/Quote]】

恩，我刚测试发现了，输入时间如：Set col = dd("2009-12-13", "2010-01-12", 3)
返回的季度只有2009Q4，少了2010Q1,不过还是谢谢您。

[「已注销」]

顶一下

[guyehanxinlei]

Friendly Up

[Tiger_Zhao]

只要先将起止时间预处理成每个时间段的开始日，然后将循环条件更改为 <= 即可

Private Function dd(ByVal startdt As Date, ByVal enddate As Date, ByVal dttype As Integer) As Collection
    Dim col As Collection
    Dim dt As Date
    Dim strYear As String
    Dim strOther As String
    
    Select Case dttype
        Case 1 'week
            startdt = DateAdd("d", 1 - DatePart("ww", startdt), startdt)
            enddate = DateAdd("d", 1 - DatePart("ww", enddate), enddate)
        Case 2 'month
            startdt = DateSerial(Year(startdt), Month(startdt), 1)
            enddate = DateSerial(Year(enddate), Month(enddate), 1)
        Case Else 'quarter
            startdt = DateSerial(Year(startdt), ((Month(startdt) - 1) \ 3) * 3 + 1, 1)
            enddate = DateSerial(Year(enddate), ((Month(enddate) - 1) \ 3) * 3 + 1, 1)
    End Select
    
    Set col = New Collection
    
    dt = startdt
    
    While dt <= enddate '<-
        strYear = CStr(Year(dt))
        Select Case dttype
            Case 1 'week
                strOther = Format(Format(dt, "ww"), "00")
                dt = DateAdd("ww", 1, dt)
            Case 2 'month
                strOther = Format(Format(dt, "mm"), "00")
                dt = DateAdd("m", 1, dt)
            Case Else 'quarter
                strOther = Format(Format(dt, "q"), "00")
                dt = DateAdd("q", 1, dt)
        End Select
        col.Add strYear & strOther
        
        'MsgBox strYear & strOther
    Wend
    
    Set dd = col
End Function

[stayor]

需要处理几种情况：起始时间、跨年、结束时间等。

[「已注销」]

[Quote=引用 16 楼 stayor 的回复:]
需要处理几种情况：起始时间、跨年、结束时间等。
[/Quote]

非常感谢，测试通过，谢谢

[vbman2003]

我也来一段，不知道是不是符合要求：

Function GetDates(dt1 As Date, dt2 As Date, dtInterval As Integer) As String()
    'dtInterval： 0＝周；1＝月；2＝季
    
    Dim n As Long, m As Long, k As Long
    Dim dt As Date
    Dim arrInterval
    
    arrInterval = Array("ww", "m", "q")
    
    n = DateDiff(arrInterval(dtInterval), dt1, dt2)
    ReDim Result(n) As String
      
    n = 0
    For dt = dt1 To dt2
        k = DatePart(arrInterval(dtInterval), dt)
        k = k + (k = 53)
        If k <> m Then
            m = k
            Result(n) = Year(dt) & Format(k, "00")
            n = n + 1
        End If
    Next
    GetDates = Result
    
End Function

Private Sub Command1_Click()
    
    Debug.Print Join(GetDates("2009-11-1", Date, 0))
    Debug.Print Join(GetDates("2009-11-1", Date, 1))
    Debug.Print Join(GetDates("2009-11-1", Date, 2))
    
End Sub

[king06]

Private Function dd(startdt As Date, enddate As Date, dttype As Integer) As Collection
    Dim col As Collection
    Dim dt As Date
    Dim strYear As String
    Dim strOther As String
    Dim m As String, t As Integer
    
    Set col = New Collection
        
    Select Case dttype
        Case 1 'week
            m = "ww"
            t = DateDiff("ww", startdt, enddate)
        Case 2
            m = "mm"
            t = DateDiff("mm", startdt, enddate)
        Case Else
            m = "q"
            t = DateDiff("q", startdt, enddate)
    End Select
        
    dt = startdt
    For i = 0 To t
        strYear = CStr(Year(dt))
        strOther = Format(Format(dt, m), "00")
        dt = DateAdd(m, 1, dt)
        
        col.Add strYear & strOther
        MsgBox strYear & strOther
    Next
    
    Set dd = col
End Function

[Thinktech2012]

正好需要，学习下。