VBAでの実現方法を教えて下さい

質問

VBA初心者です。

引数として「日付from(YYYYMM)、日付to(YYYYMM)、間隔」を渡し、戻り値として配列を受け取るプログラミングを考えています。
既存関数などを利用して、実現したいのですが、実現方法がわかりません。
有識者の方、ご教授頂けないでしょうか。

（例）引数「200701(string), 200712(string), 3(integer)」
⇒戻り値
hairetu(0,0)="200701"
hairetu(0,1)="200703"

hairetu(1,0)="200704"
hairetu(1,1)="200706"

hairetu(2,0)="200707"
hairetu(2,1)="200709"

hairetu(3,0)="200710"
hairetu(3,1)="200712"

回答No.1

fumufumu_2006 · ベストアンサー

こんなのではどうでしょうか？
引数が、"200701","200711",3 だった場合などは、どういう戻り値にするのかわかららないのでチェックしてませんが・・・
ちなみにExcelのVBAです。

Option Explicit
Function sample(dateFrom As String, dateTo As String, interval As Integer) As String()
Dim dFrom As Date
Dim dTo As Date
Dim res() As String
Dim n As Integer
Dim i As Integer
'文字列->日付への変換("yyyymm"->"yyyy/mm/01"として）
dFrom = CDate(Format(dateFrom & "01", "@@@@/@@/@@"))
dTo = CDate(Format(dateTo & "01", "@@@@/@@/@@"))
'戻り値の個数の計算(期間内月数\間隔)
n = DateDiff("m", dFrom, dTo) \ interval
ReDim res(n, 1)
'戻り値をセット
For i = 0 To n
res(i, 0) = Format(dFrom, "yyyymm")
res(i, 1) = Format(DateAdd("m", interval - 1, dFrom), "yyyymm")
dFrom = DateAdd("m", interval, dFrom)
Next
sample = res
End Function

Sub test()
Dim hairetu() As String
Dim i As Integer
hairetu = sample("200701", "200710", 3)
For i = 0 To UBound(hairetu)
MsgBox hairetu(i, 0) & "-" & hairetu(i, 1)
Next
End Sub

お礼

回答ありがとうございます。
お陰で問題無く実装できました。

回答No.2

Wendy02

こんにちは。

>引数「200701(string), 200712(string), 3(integer)」

現実的に、パーツとしてユーザー定義関数で、そのような2次元配列による出力をしても、全体のプロシージャが伴わないと、うまく行かないような気もします。

#1さんの内容とは重複する部分もあるのですが、私は、私なりに考えてみました。引数が違う場合は、明示的に配列出力をしないのは、On Error Resume Next でしか、エラーを取れないような気がしましたので、エラー値を出すようにしました。だから、Variant 型で戻り値を受けてあげれば、IsError で取れます。いまどきは、そんなことはどうでもよい言われそうですが。

なお、区間が割り切れない場合は、区間の最終月を終了側に入れます。
'-----------------------------------------------

Sub TestA()
Dim a As Variant
a = DatesAcc("200701", "200712", 3)
End Sub

Function DatesAcc(ByVal sStart As String, ByVal sEnd As String, ByVal period As Variant)
'引数：sStart--始まり, sEnd--終わり,period--期間
　　Dim i As Date, j As Date, t As Date
　　Dim n As Integer
　　Dim x As Integer
　　Dim k As Integer
　　Dim dif As Integer
　　Dim Ar() As String

　　If Len(sStart) = 6 And Len(sEnd) = 6 And IsNumeric(period) Then
　　　　i = CDate(Format(sStart & "01", "@@@@/@@/@@"))
　　　　j = CDate(Format(sEnd & "01", "@@@@/@@/@@"))
　　Else
　　　　'エラー値出力
　　　　DatesAcc = CVErr(xlErrValue)
　　　　Exit Function
　　End If
　　If i > j Then t = i: i = j: j = t
　　dif = DateDiff("m", i, j)
　　n = Int(dif / period) + 1
　　ReDim Ar(n - 1, 1)

　　x = 0
　　For k = 0 To n - 1
　　　　Ar(k, 0) = Format$(DateAdd("m", x, i), "yyyymm")
　　　　If j >= DateAdd("m", x + (period - 1), i) Then
　　　　　　Ar(k, 1) = Format$(DateAdd("m", x + (period - 1), i), "yyyymm")
　　　　Else
　　　　　　Ar(k, 1) = Format$(j, "yyyymm")
　　　　End If
　　　　x = x + period
　　Next k
　　DatesAcc = Ar()
End Function

お礼

回答ありがとうございます。
お陰で問題無く実装できました。