『カレンダーの作成』（7個）

教えてください。
A1に×年○月を入力すると、B2に○月1日・C2に○月2日・D3に○月3日・・・末日まで。
と表示させるカレンダーを作成したいのですがよろしくお願いします。


----
 A1に
 "2008/1/1"
 と入力("2008/1"と入力しても自動的に"22008/1/1"となると思います。)
 B2=IF(MONTH($A$1+COLUMN()-2)<>MONTH($A$1),"",$A$1+COLUMN()-2)
 B2をC2〜AF2にコピー

 A1の日付の月と、A1の日付に列番号を加算して算出した日付の月とを比較し、
 月が違ったら表示しない、という方法をとっています。
 (MARBIN)
----
 なお、
 "2008/1/1"
 は表示形式で表示方法を変えられます。
 ユーザー定義書式を使います。

 一例です。
 "yyyy年m月"→"2008年1月"
 "yyyy年mm月"→"2008年01月"
 "yy年mm月"→"08年01月"
 "gggee年m月"→"平成20年1月"
 "[DBNum3]ggge年m月"→"平成２０年１月"
 (MARBIN)
----
 なお、A1に文字列で"2008年1月"と入力されている場合は、
 B2=DATEVALUE(A1&COLUMN()-1&"日")
 で日付データに変換できます。
 (MARBIN)
----
 なお（その３
 上の[全文検索]の[もっとも多く検索されたキーワード]にもカレンダーがありますよ＾＾
 （dack）
----
 今月を例にとるならA1セルに12/1と入力することをお薦めします。エクセルは2007/12/1と認識します。
 あとは、MARBINさんがご提示のユーザー定義で表示形式は選択すればよろしいと思います。

 B2=A1
 C2=B2+1 としてAF2(31日)までフィルコピー

 AC2からAF2までドラッグ選択しておいて（28〜31日分）
 条件付き書式
 数式が　=MONTH($A$1)<>MONTH(AC2)        書式　フォント　白

 小の月の場合、AF2には翌月1日が入りますがフォントを白色にして見えなくする手法です。(gon-2)
----
 こんなスーパーカレンダーはどうでっか？
 そのシートのシートモジュールにコピペします。
 入力は３でも３月でも3でも平成１９年３月でもH19.3でもＨ１９．３でも２００７／３
 でも2007/3でもＯＫですワ。
 しかも土、日にはご丁寧に色付けまでする至れり尽くせりのカレンダーでっせぇ。
 　　　　　　　（弥太郎）
 '--------------------------
 Option Base 1
 Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Integer, n As Integer, data, ary, x()
    With Target
        If .Count > 1 Then Exit Sub
        If .Address(0, 0) <> "A1" Then Exit Sub
        .NumberFormatLocal = "G/標準"
        If .Value = "" Then Cells(1, 2).Resize(2, Columns.Count - 1).Clear: Exit Sub
        If IsNumeric(.Value) And Len(.Value) = 5 Then .NumberFormatLocal = "yyyy/m"
        data = StrConv(.Value, vbNarrow)
        data = IIf(IsNumeric(data), data & "月", data)
        data = Replace(Replace(Replace(data, "H", "平成"), "S", "昭和"), "T", "大正")
    End With
    On Error Resume Next
    data = Split(data, ".")(0) & "年" & Split(data, ".")(1) & "月"
    data = Format(data, "yyyy/m")
    If Not IsDate(data) Then
        data = Format(Year(Now) & "/" & Val(data), "yyyy/m")
    End If
    ary = Array(31, IIf(Year(data) Mod 4 = 0, 29, 28), 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
    For i = 1 To 12
        If Month(data) = i Then Exit For
    Next i
    Application.EnableEvents = False
    Cells(1, 2).Resize(2, Columns.Count - 1).Clear
    For n = 1 To ary(i)
        ReDim Preserve x(1 To 1, 1 To n)
        x(1, n) = data & "/" & n
    Next n
    Cells(1, 2).Resize(, UBound(x, 2)) = x
    Cells(1, 2).Resize(, UBound(x, 2)).NumberFormatLocal = "m月d日"
    For n = 2 To UBound(x, 2)
         Cells(1, n).Font.ColorIndex = IIf(Weekday(Cells(1, n)) = 7, 5, _
                        IIf(Weekday(Cells(1, n)) = 1, 3, xlAutomatic))
    Next n
    Application.EnableEvents = True
 End Sub


----
 横槍マクロです・・・。
 弥太郎さんのマクロに↓を追加してみてください。

 '標準モジュール
 Sub haiti()
  With ActiveSheet.Cells(2, 1)
   .Value = "前"
   .Font.Color = vbBlue
  End With
  With ActiveSheet.Cells(3, 1)
   .Value = "後"
   .Font.Color = vbRed
  End With
 End Sub

 'シートモジュールに追加
 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Range("A1").Value = "" Then Exit Sub
  If Intersect(Target, Range("A2:A3")) Is Nothing Then Exit Sub
  Cancel = True
  With Range("A1")
   Select Case Target.Address(0, 0)
    Case "A2"
    .Value = DateAdd("m", -1, .Value)
    Case "A3"
    .Value = DateAdd("m", 1, .Value)
   End Select
  End With
 End Sub

 先ず、"haiti"を実行してください。
 A1に入力した日付を"前"、"後"のセルのダブルクックで一ヶ月単位で前後させることが出来ます。
 A1に何も入力されていなければ"前"、"後"のセルをダブルクックしても何もおきません。

 (MARBIN)
----
 んじゃこっちはMARBINはんのを真似てスピンボタンバージョンといきまひょか。＾＾
 そのシートにコントロールツールボックスからスピンボタンを配置します。
 入力は３でも3でも３月でも平成１９年３月でもＨ１９．３でも２００７／３でも
 ＯＫです。
 ただ、年を入力しなければ当該年度しか表示しまへん。
 また大正以前のカレンダーは作成でけまへん。
 　　　　　　　（弥太郎）
 '------------------------
 Option Base 1
 Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Integer, n As Integer, data, ary, x()
    With Target
        If .Count > 1 Then Exit Sub
        If .Address(0, 0) <> "A1" Then Exit Sub
        Application.ScreenUpdating = False
        .NumberFormatLocal = "G/標準"
        If .Value = "" Then Cells(1, 2).Resize(2, 31).Clear: Exit Sub
        Application.EnableEvents = False
        .Value = StrConv(.Value, vbNarrow)
        If IsNumeric(.Value) And Len(.Value) = 5 Then .NumberFormatLocal = "yyyy/m"
        data = .Value
        data = IIf(IsNumeric(data), data & "月", data)
        data = Replace(Replace(Replace(data, "H", "平成"), "S", "昭和"), "T", "大正")
        data = Replace(Replace(Replace(data, "(", ""), ")", ""), ".", "年")
    End With
    On Error Resume Next
    With CreateObject("vbscript.regexp")
        data = Format(data, "yyyy/m")
        If Not IsDate(data) Then
            .Pattern = "^(\D+)(\d+)(\D+)(\d+)(\D+)*"
            If .test(data) And Not data Like "*/*" Then
                data = .Replace(data, "$1") & .Replace(data, "$2") & .Replace(data, "$3") & _
                        .Replace(data, "$4") & "月"
                data = Format(data, "yyyy/m")
            Else
                .Pattern = "(\d+)(\D+)*"
                If .test(data) And Not data Like "*/*" Then
                    data = Format(Year(Now) & "/" & .Replace(data, "$1"), "yyyy/m")
                Else
                    .Pattern = "(\d{4}\/\d+)(\D+)*"
                    If .test(data) Then
                        data = .Replace(data, "$1")
                    Else
                        data = Format(Year(Now) & "/" & Val(data), "yyyy/m")
                    End If
                End If
            End If
        End If
    End With
    ary = Array(31, IIf(Year(data) Mod 4 = 0, 29, 28), 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
    For i = 1 To 12
        If Month(data) = i Then Exit For
    Next i
    Cells(1, 2).Resize(2, 31).Clear
    For n = 1 To ary(i)
        ReDim Preserve x(1 To 2, 1 To n)
        x(1, n) = data & "/" & n
        x(2, n) = Format(data & "/" & n, "aaa")
        Cells(2, n + 1).Font.ColorIndex = IIf(Weekday(x(1, n)) = 7, 5, _
                        IIf(Weekday(x(1, n)) = 1, 3, xlAutomatic))
    Next n
    Cells(1, 2).Resize(, UBound(x, 2)).NumberFormatLocal = "m月d日"
    Cells(1, 2).Resize(2, UBound(x, 2)) = x
    Application.EnableEvents = True
    Application.ScreenUpdating = True
 End Sub
 Private Sub SpinButton1_Change()
    Dim flag As Boolean, i As Integer, ary, d, data
    SpinButton1.Max = 1
    SpinButton1.Min = -1
    If SpinButton1.Value = 0 Then Exit Sub
    If Range("A1").Value = "" Then SpinButton1.Value = 0: Exit Sub
    With CreateObject("vbscript.regexp")
        If Not Range("a1") Like "*/*" Then
            .Pattern = "^(\()*(\d+)(\D+)*"
            If .test(Range("a1").Text) Then
                data = .Replace(Range("a1"), "$2") + SpinButton1.Value
                data = IIf(data = 0, 12, IIf(data = 13, 1, data))
                Range("a1") = .Replace(Range("a1"), "$1") & data & .Replace(Range("a1"), "$3")
                SpinButton1.Value = 0
                Exit Sub
            Else
                .Pattern = "^(\()*(\D+)(\d+)(\D+)(\d+)(\D+)*"
                If .test(Range("a1")) Then
                    ReDim d(1 To 5)
                    For i = 1 To 5
                        d(i) = .Replace(Range("a1"), "$" & i + 1)
                    Next i
                    flag = True
                End If
            End If
        ElseIf Not IsDate(Range("a1")) Then
            .Pattern = "^(\()*(\d{4}/\d+)(\D+)*"
            If .test(Range("a1")) Then
                data = .Replace(Range("a1"), "$2") & "/" & 1
                Range("a1") = .Replace(Range("a1"), "$1") & Format(DateAdd("m", _
                        SpinButton1.Value, data), "yyyy/m") & .Replace(Range("a1"), "$3")
                SpinButton1.Value = 0
                Exit Sub
            End If
        End If
        ary = Array("平成", "昭和", "大正", "H", "S", "T")
        If flag Then
            Select Case SpinButton1.Value
                Case -1
                    If d(1) = "大正" Or d(1) = "T" Then
                        If d(2) = 1 And d(4) = 1 Then MsgBox "それ以下はあきまへん", _
                                    vbExclamation: SpinButton1.Value = 0: Exit Sub
                        d(2) = IIf(d(4) = 1, d(2) - 1, d(2))
                    Else
                        d(1) = IIf(d(2) = 1 And d(4) = 1, ary(Application.Match(d(1), ary, 0) + 1), d(1))
                        d(2) = IIf(d(2) = 1 And d(4) = 1, IIf(d(1) = "昭和" Or d(1) = "S", 63, 14), _
                                            IIf(d(4) = 1, d(2) - 1, d(2)))
                    End If
                    Range("a1") = .Replace(Range("a1"), "$1") & d(1) & d(2) & d(3) & IIf(d(4) = 1, _
                                    12, d(4) - 1) & d(5)
                Case 1
                    If d(1) = "平成" Or d(1) = "H" Then
                        d(2) = IIf(d(4) = 12, d(2) + 1, d(2))
                    Else
                        d(1) = IIf((d(2) = 14 And d(4) = 12 And (d(1) = "大正" Or d(1) = "T")) Or (d(2) = 63 _
                                And d(4) = 12 And (d(1) = "昭和" Or d(1) = "S")), ary(Application.Match(d(1), _
                                ary, 0) - IIf(d(1) = "平成" Or d(1) = "H", 0, 1)), d(1))
                        d(2) = IIf((d(2) = 14 And d(4) = 12 And (d(1) = "昭和" Or d(1) = "S")) Or _
                                (d(2) = 63 And d(4) = 12 And d(1) = "平成" Or d(1) = "H"), _
                                    1, IIf(d(4) = 12, d(2) + 1, d(2)))
                    End If
                    Range("a1") = .Replace(Range("a1"), "$1") & d(1) & d(2) & d(3) & IIf(d(4) _
                                        = 12, 1, d(4) + 1) & d(5)
            End Select
        Else
            Range("a1") = DateAdd("m", SpinButton1.Value, Range("a1"))
        End If
    End With
    SpinButton1.Value = 0
 End Sub
----
 カレンダーの日付を関数で参照するとえらい間違いが起こる重大ミスを発見。（汗
 過去ログ頼りに訪れる御方の為にも訂正しておく必要がありますんで、上記コード
 差し替えました。償いとして（平成19年3月分）等とカッコにも対応するよう機能を
 アップしときました、やれやれ。
 　　　　　　（弥太郎）

----
＞カレンダーの日付を関数で参照するとえらい間違いが起こる重大ミスを発見

重大ミスとは？？？

GGG
----
 差し替える前のマクロはこうなっとりましたんですワ。
 A1に平成１６年３月度と入力しても
 B1の日付は2007/3/1と表示しとりました。
 ○月○日の表示自体はその月の日数で表示されますから、カレンダー単体で使用する
 ばやいは何ら問題はないんですけど、その表示された日付を利用して、例えば
 どっかのセルに=DATEDIF(B1,NOW(),"m")
 と入力すると求める数値とは全く違う結果が出る事になります。
 起算日が2004/3/1で有るべき筈が2007/3/1になっとるのが原因なんですワ。
 
 上のコードをコピペして今年以外の年代をA1に記入すれば上の式は有効になりますが
 B1に３月１日と入力しますと、どうでっか？結果はちがいまっしゃろ？
 こんな説明でご理解頂けましたかしら。　　　　　　　　　　　　　　
 　　　　　　　　　　　　　（弥太郎）