|
|
|
セルに日付を入力する際の基本は､「2007/12/20」という風に年月日の全てを入力する事ですが､
年を省略して「12/20」と入力する事も可能です。ただし､この場合は入力操作時のマシン日付の『年』
として書き込まれます。
例えば､2006/12/20を入力するつもりで「12/20」と入力しても､その時のマシン日付が2007年だった
としたら､セルには「2007/12/20」として書き込まれてしまいます。2006/12/20として入力するには､年
から「2006/12/20」とタイプする必要があります。
また､１ヶ月単位の日別明細シート等で､毎回毎回「年月日」（当年中の操作なら月日でも可）と入力
するのも非常に面倒です。
単純に「１〜３１」を入力すれば『その年月の日付』として書き込めれば､非常に楽ですね。
ここで紹介するのは日経ＰＣ２１「腕自慢2007 マクロＱ２」を応募する際に､おまけ機能として考えた
日付入力支援マクロです。
【 腕自慢2007マクロＱ２ 応募作品 PC21_2007_Macro2.lzip (47KB) 】
（出題内容）
月別の出納帳シート（シート名は "yyyy年m月" 形式の年月）から､当月シートをコピーして
翌月シートを作成する（当月残高を翌月シートの前月繰越セルに設定し､明細欄をクリアする）。
【 利用方法 】
この機能を利用するには､標準モジュールに以下の『曖昧日付入力』サブルーチンをコピーし､後述の
例のように､ThisWorkbookモジュール もしくは シートモジュールの『Change 』イベント内から､この曖昧
日付入力サブルーチンを呼び出します。
〜〜 曖昧日付入力サブルーチンの利用条件 〜〜
(1) 日付入力セルには予め日付書式を設定しておいて下さい。
(2) また､その日付入力欄の「基準年月」情報を渡す必要があります。例では､シート名を年月としてい
るので､シート名を基準年月情報として利用しています。他に､どこかのセル上に基準年月（年月日
でも可）を用意して､そのセル内容を渡すようにしても良いです。
(3) Change イベントで曖昧日付入力を呼び出す際は､『単一セル』のChange イベントである事を事前
にチェックしてください。
基準年月を「2007年1月」とした場合､以下のような結果で書き込まれます。
・ 1 〜 31 入力 → 2007/1/1 〜 2007/1/31
・ マシン日付が2006年時点で､1/1 〜 1/31 入力 → 2007/1/1 〜 2007/1/31
(通常ならば 2006/1/1〜2006/1/31 になる)
・ 例え､3/1 〜 3/31 と入力しても 2007/1/1 〜 2007/1/31 になる
基準年月が「小の月 または ２月」では､
・ ３１(小の月) or ２９〜３１(平年２月) or ３０〜３１(閏年２月） 入力
・ 例えば､3/31 と入力
とした場合には､基準年月の「月末日」になります。
(注) マシン日付が平年の場合､エクセルの仕様上､ 2/29 という入力は「日付」にはなりません。
※ 標準モジュール ※
Public Sub 曖昧日付入力(ByVal Rng As Range, ByVal BaseDate As Date)
'[M/D or Dのみ]日付入力に対し､指定の基準年月の日付として書き換える
'--利用条件--
' (1)Rngの指すセルは[単一セル]のみ可(事前にチェックする事[Rng.Cells.Count = 1])
' (2)Rngの指すセルには日付形式の書式が設定されている事
' (3)BaseDateは[１日]以外でも可
Dim strBaseYM As String
Dim dtm1stDay As Date
Dim dtmEndDay As Date
strBaseYM = Format(BaseDate, "yyyy/m/")
dtm1stDay = DateValue(strBaseYM & "1")
dtmEndDay = DateAdd("m", 1, dtm1stDay) - 1
Application.EnableEvents = False
If (Rng.Value = Empty) Then
'セルクリア操作
'ゼロ入力(セル上の日付で1900/1/0)もTrueになる為､ここで入力無効にする
'(Emptyが数値比較ではゼロ扱いになる為)
Rng.ClearContents
ElseIf (IsDate(Rng.Value)) Then
'書式設定が日付なので､数値入力(1〜31)も[IsDate=True]で判定する
'([IsNumeric]はFalseになる)
'マイナス値もセル上は####表示でエラーだが､VBAからは[IsDate=True]
Select Case Rng.Value
Case Is < 0
'セルでは日付として扱えない為､入力を無効にする
Rng.ClearContents
Case 1 To 31 'シリアル値(日付書式)では[1900/1/1〜1/31]を意味する
'Dのみ日付入力
If (Rng.Value <= Day(dtmEndDay)) Then
Rng.Value = DateValue(strBaseYM & CInt(Rng.Value))
Else
'2月/小の月で[>月末日]は月末日とする
Rng.Value = dtmEndDay
End If
Case dtm1stDay To dtmEndDay
'Y/M/D日付入力なので､そのまま
Case Else
'M/D日付入力､年または年月が基準年月と異なっているので修正する
If (Day(Rng.Value) <= Day(dtmEndDay)) Then
Rng.Value = DateValue(strBaseYM & Day(Rng.Value))
Else
'2月/小の月で[>月末日]は月末日とする
Rng.Value = dtmEndDay
End If
End Select
Else
'文字etc は入力無効とする
Rng.ClearContents
End If
Application.EnableEvents = True
End Sub
ThisWorkbook モジュールで複数シートを一緒に処理する例です。
日付入力がある各シートは､「2007年1月」「2007年12月」と年月がシート名になっている前提です。
日付入力セル範囲 [ Ｂ３：Ｂ４０ ] 。
※ ThisWorkbookモジュール ※
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'======【 日付欄入力のサポート 】==============
If (Sh.Name Like "####年#月") Or (Sh.Name Like "####年##月") Then
'出納簿シート
If (Target.Cells.Count = 1) Then
'単一セル
If (Target.Column = 2) And _
(Target.Row >= 3) And _
(Target.Row <= 40) Then
'日付欄で[日]のみor[月/日]入力でも正しくシート名の年月の日付に変換する
Call 曖昧日付入力(Target, CDate(Sh.Name & "1日"))
End If
End If
End If
End Sub
個々のシートモジュールで処理する例です。
「2007年1月」「2007年12月」と年月がシート名になっている前提です。
日付入力セル範囲 [ Ｂ３：Ｂ４０ ] 。
※ シートモジュール ※
Private Sub Worksheet_Change(ByVal Target As Range)
'======【 日付欄入力のサポート 】==============
If (Target.Cells.Count = 1) Then
'単一セル
If (Target.Column = 2) And _
(Target.Row >= 3) And _
(Target.Row <= 40) Then
'日付欄で[日]のみor[月/日]入力でも正しくシート名の年月の日付に変換する
Call 曖昧日付入力(Target, CDate(Me.Name & "1日"))
End If
End If
End Sub
 |
 |
|
|
|
||
| 角田 桂一 Mail:addinbox@h4.dion.ne.jp CopyRight(C) 2007 Allrights Reserved. | ||