【 2016年9月15日  サイト 移転のお知らせ 】
      AddinBox サイトを [ DION ] から [ さくら インターネット ] へ移転しました。  なお、旧サイト は 2017年10月 まで残します。
      この ページ の 移転先 URL  ⇒⇒  http://addinbox.sakura.ne.jp/Excel_Tips19.htm  
 
ロゴ(青) Excel/VBA Tips ロゴ(緑)

Tips19: セル『日付入力』支援

  セルに日付を入力する際の基本は、「2007/12/20」という風に年月日の全てを入力する事ですが、
年を省略して「12/20」と入力する事も可能です。ただし、この場合は入力操作時のマシン日付の『年』
として書き込まれます。
  例えば、2006/12/20を入力するつもりで「12/20」と入力しても、その時のマシン日付が2007年だった
としたら、セルには「2007/12/20」として書き込まれてしまいます。2006/12/20として入力するには、年
から「2006/12/20」とタイプする必要があります。
  また、1ヶ月単位の日別明細シート等で、毎回毎回「年月日」(当年中の操作なら月日でも可)と入力
するのも非常に面倒です。

  単純に「1〜31」を入力すれば『その年月の日付』として書き込めれば、非常に楽ですね。

  ここで紹介するのは日経PC21「腕自慢2007 マクロQ2」を応募する際に、おまけ機能として考えた
日付入力支援マクロです。
    【 腕自慢2007マクロQ2 応募作品  PC21_2007_Macro2.lzh  (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 になる

基準年月が「小の月 または 2月」では、
  ・ 31(小の月) or 29〜31(平年2月) or 30〜31(閏年2月) 入力
  ・ 例えば、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は[1日]以外でも可
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 = EmptyThen
        'セルクリア操作
        'ゼロ入力(セル上の日付で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月」と年月がシート名になっている前提です。
日付入力セル範囲 [ B3:B40 ] 。
※ ThisWorkbookモジュール ※

Private Sub Workbook_SheetChange(ByVal Sh As ObjectByVal 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月」と年月がシート名になっている前提です。
日付入力セル範囲 [ B3:B40 ] 。
※ シートモジュール ※

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




 Home   Back Page   Next Page

ロゴ(ゴールド)   ロゴ(ゴールド)

角田 桂一 Mail:addinbox@h4.dion.ne.jp CopyRight(C) 2007 Allrights Reserved.