Excel VBAのマクロに詳しい方、お願いします。


日付を入力すると、年次の通し番号(ウィークリー)に変換するというユーザー関数を作っていただけませんか?

基点は1月の最初の月曜で、例えば2005年なら、0501(yy+通し番号)として、最後の週は0552になります。来年はリセットされて、0601からスタートします。

逆に、通し番号と曜日を入力すると、それに対応する日付を吐き出すユーザー関数も欲しいです。

例えば(0535,月)と入力したら、2005/08/22を出力させたいのです。


宜しくお願いします

回答の条件
  • URL必須
  • 1人2回まで
  • 登録:2005/08/26 00:03:20
  • 終了:--

回答(2件)

id:ku__ra__ge No.1

ku__ra__ge回答回数118ベストアンサー獲得回数402005/08/26 01:11:08

ポイント30pt

URLはダミーです。

Date2WeekSerialは、日付→yy+通し番号。

WeekSerial2Dateは、yy+通し番号→日付です。


WeekSerial2Dateの第二引数には、1:日曜, 2:月曜, 3:火曜, 4:水曜, 5:木曜, 6:金曜, 7:土曜のいずれかの数字を指定してください。


ちなみに、最初の月曜日(2005/01/03)~次の月曜日(2005/01/09)が0501とすると、

2005/08/22は、053「4」の月曜日になったのですが、もしかして私、仕様を勘違いしてます?


====以下ソース====


Option Explicit


Public Function Date2WeekSerial(ByVal pDate As Date) As String

Dim dBaseDate As Date


Date2WeekSerial = Format(pDate, ”yy”)

dBaseDate = Year(pDate) & ”/01/01”

Do Until weekday(dBaseDate) = vbMonday

dBaseDate = dBaseDate + 1

Loop

If dBaseDate > pDate Then

Date2WeekSerial = Date2WeekSerial & ”00”

Else

Date2WeekSerial = Date2WeekSerial & Format(DateDiff(”w”, dBaseDate, pDate) + 1, ”00”)

End If

End Function


Public Function WeekSerial2Date(ByVal pWeekSerial As String, ByVal pWeekDay As Integer) As Date

Dim sYear As String

Dim sSerial As String

If IsNumeric(pWeekSerial) = False Then

WeekSerial2Date = ”#ERR#”

Exit Function

End If

pWeekSerial = Format(pWeekSerial, ”0000”)

sYear = Left(pWeekSerial, 2)

sSerial = Mid(pWeekSerial, 3, 2)

sYear = IIf(CInt(sYear) >= 50, ”19”, ”20”) & sYear

WeekSerial2Date = sYear & ”/01/01”

If sSerial > 0 Then

Do Until weekday(WeekSerial2Date) = vbMonday

WeekSerial2Date = WeekSerial2Date + 1

Loop

WeekSerial2Date = DateAdd(”ww”, CInt(sSerial - 1), WeekSerial2Date)

End If

Do Until weekday(WeekSerial2Date) = pWeekDay

WeekSerial2Date = WeekSerial2Date + 1

Loop

End Function

id:expansion05

ありがとうございます。さっそくテストしてみます

2005/08/26 06:17:20
id:ycyc No.2

ycyc回答回数37ベストアンサー獲得回数62005/08/26 02:09:34

ポイント30pt

http://www.hatena.ne.jp/1124982200

人力検索はてな - Excel VBAのマクロに詳しい方、お願いします。 日付を入力すると、年次の通し番号(ウィークリー)に変換するというユーザー関数を作っていただけませんか? 基点は1月の..

’----------------------------------------------------------------------

’ 日付から年(下2桁)+週を求める

’ @param dDate 日付

’ @return 年(下2桁)+週(2桁)

’----------------------------------------------------------------------

Private Function date2yweek(dDate As Date) As String

Dim nYear As Integer

Dim szRet As String

’ 年の取得

nYear = Year(dDate) Mod 100

szRet = treatNum(nYear, 2)

’ 週の取得

Dim nWeeknum As Integer

nWeeknum = Format(dDate, ”ww”, vbMonday) - 1

szRet = szRet + treatNum(nWeeknum, 2)

date2yweek = szRet

End Function

’----------------------------------------------------------------------

’ 年(下2桁)+週と曜日から、日付を求める

’ @param 年(下2桁)+週(2桁) 4桁固定であること

’ @param 曜日

’ @return 日付

’----------------------------------------------------------------------

Private Function yweek2date(szYWeek As String, szWeekday As String) As Date

Dim dDateInit As Date ’ 1月1日の日付

Dim dDateStart As Date ’ 第1週の開始日(日曜日)

Dim dDate As Date ’ 指定週の開始日(日曜日)

’ 年の取得

Dim nYear As Integer

nYear = 2000 + Left(szYWeek, 2)

’ 週の取得

Dim nWeeknum As Integer

nWeeknum = Right(szYWeek, 2) - 1

’ 曜日の取得

Select Case szWeekday

Case ”月”

nOffset = 1

Case ”火”

nOffset = 2

Case ”水”

nOffset = 3

Case ”木”

nOffset = 4

Case ”金”

nOffset = 5

Case ”土”

nOffset = 6

Case ”日”

nOffset = 7

End Select

’ 年初の曜日により、第1週の開始日を求める

dDateInit = nYear & ”/1/1”

Dim nWeekDay As Integer

nWeekDay = Weekday(dDateStart)

dDateStart = DateAdd(”d”, 1 - nWeekDay, dDateInit)

’ 指定した週をプラス

dDate = DateAdd(”ww”, nWeeknum, dDateStart)

’ 指定した曜日分をプラス

yweek2date = DateAdd(”d”, nOffset, dDate)

End Function

’----------------------------------------------------------------------

’ 桁数そろえ

’ @param nVal 値

’ @param nDegit 桁

’ @return 桁数にそろえられた文字列

’----------------------------------------------------------------------

Private Function treatNum(nVal As Integer, nDegit As Integer) As String

Dim szVal As String

Dim nAt As Integer

szVal = Trim(Str(nVal))

While (Len(szVal) < nDegit)

szVal = ”0” & szVal

Wend

treatNum = szVal

End Function

id:expansion05

最初の方とはまた違うアルゴリズムですね!勉強させていただきます。ありがとうございました。

2005/08/26 06:19:09
  • id:sparituda
    関数だと...

    マクロというご要望ですが、関数でもできそうです。

    1.日付→年下2桁+第nn週
    セルA1に日付のシリアル値が入っているとすると。
    =TEXT(A1,”yy”)&TEXT(WEEKNUM(A1,2)-1,”00”)
    ただし、WEEKNUM()を使用するにはアドインの分析ツールが必要。
    なお、最初の月曜の前は第ゼロ週、最後の週は第53週になります。

    2.年下2桁+第nn週,曜日→日付
    セルB1に”YYnn”形式の文字列、C1に曜日が漢字1文字で入っているとすると。
    まず、D1にその年の1月1日のシリアル値をセット。
    =DATE(2000+LEFT(B1,2),1,1)
    B1,C1,D1を元に、目的の日付のシリアル値を計算。
    =D1+RIGHT(B1,2)*7+FIND(C3,”月火水木金土日”)-WEEKDAY(D1,2)
    D1を1つ目の式に置き換えれば、1回の計算でもできるけど...どちらにしろ長すぎ。
  • id:sparituda
    訂正

    >なお、最初の月曜の前は第ゼロ週、最後の週は第53週になります。
    53週にはなりません。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません