Results of 1 - 1 of about 1242 for カレンダー (0.001 sec.)
- [[20071213182459]]
- #score: 6118
- @digest: 24e27c3f134fb7098810fcb2c61363b0
- @id: 34996
- @mdate: 2007-12-19T10:23:51Z
- @size: 12104
- @type: text/plain
- #keywords: 月"→ (37491), spinbutton1 (25155), 大ミ (20867), 和" (12960), 大正 (10815), 後" (8564), data (8415), 重大 (7626), replace (6954), 成19 (6640), 平成 (6296), 成" (5834), 昭和 (5451), 前" (5241), dateadd (4672), 月" (4084), カレ (4061), iif (3809), numberformatlocal (3459), pattern (3157), 年m (3109), 年3 (2942), ary (2689), レン (2528), 年1 (2316), ンダ (2227), isnumeric (2157), 弥太 (2090), ダー (2063), yyyy (2040), format (1953), weekday (1888)
- 『カレンダーの作成』（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月"→"平成20年1月" (MARBIN) ---- なお、A1に文字列で"2008年1月"と入力されている場合は、 B2=DATEVALUE(A1&COLUMN()-1&"日") で日付データに変換できます。 (MARBIN) ---- なお（その3 上の[全文検索]の[もっとも多く検索されたキーワード]にもカレンダーがありますよ^^ （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でも3月でも3でも平成19年3月でもH19.3でもH19.3でも2007/3 でも2007/3でもOKですワ。 しかも土、日にはご丁寧に色付けまでする至れり尽くせりのカレンダーでっせぇ。 （弥太郎） '-------------------------- 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でも3でも3月でも平成19年3月でもH19.3でも2007/3でも OKです。 ただ、年を入力しなければ当該年度しか表示しまへん。 また大正以前のカレンダーは作成でけまへん。 （弥太郎） '------------------------ 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に平成16年3月度と入力しても B1の日付は2007/3/1と表示しとりました。 ○月○日の表示自体はその月の日数で表示されますから、カレンダー単体で使用する ばやいは何ら問題はないんですけど、その表示された日付を利用して、例えば どっかのセルに=DATEDIF(B1,NOW(),"m") と入力すると求める数値とは全く違う結果が出る事になります。 起算日が2004/3/1で有るべき筈が2007/3/1になっとるのが原因なんですワ。 上のコードをコピペして今年以外の年代をA1に記入すれば上の式は有効になりますが B1に3月1日と入力しますと、どうでっか?結果はちがいまっしゃろ? こんな説明でご理解頂けましたかしら。 （弥太郎）... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/200712/20071213182459.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97059 documents and 608315 words.
訪問者：