人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

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

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

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

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

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


宜しくお願いします

●質問者: expansion05
●カテゴリ:コンピュータ 科学・統計資料
✍キーワード:2005年 Excel VBA ウィークリー スタート
○ 状態 :終了
└ 回答数 : 2/2件

▽最新の回答へ

1 ● ku__ra__ge
●30ポイント

http://www.google.ne.jp/

Google

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

◎質問者からの返答

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


2 ● ycyc
●30ポイント

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

◎質問者からの返答

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

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ