[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『タイムカードの作成方法について』（evian）
毎々お世話になります。よろしくおねがいいたします。
下記のようなタイムカードがあります。
A1 B1 C1 D1 １ 水 9:00 17:00 (日付）(曜日）（出勤） （退出）
となっていて、2月の場合は28日まであります。 土曜日と日曜日と祭日は1行全て網掛けになります。 毎月、曜日と網掛けを入力しなおししているのですが、 簡単にできる方法はないでしょうか。m(__)m （@evian）
A1には「1」だけですか？ 2006/2/1と入っていて、表示をdとしているのですか？ どちらかによって対応が変わってきますので・・・ (ROUGE)
ちなみに、2006/2/1とはいっていると仮定すると B1=TEXT(WEEKDAY(A1),"aaa") です。 1だけだったら、~~ここにDATE関数をネスト（年と月のセルを作る） あとは条件付書式を使って色を付けて下さい。 (ROUGE)
ありがとうございました。 A1には、数式ははいっていなくて、「1」だけです。 A1に、2006/2/1をいれて表示をdにして、 B1=TEXT(WEEKDAY(A1),"aaa") を入れればいいのですね。 これはわかりました。
ちなみに 1だけだったら、~~ここにDATE関数をネスト（年と月のセルを作る） この意味がよくわからないのですが、教えていただけますか？
E1に2006（年）、F1に2（月）とはいっているとすると、 B1=TEXT(WEEKDAY(DATE($E$1,$F$1,$A1)),"aaa") ということです。 (ROUGE)
お返事どうもありがとうございました。 では、セルを増やしたくないのでA1に日付形式のINPUTに変更します。
それから条件書式は、なにを使えばいいのでしょうか？ 単語検索でしらべてWEEKENDとかを使ってやってみたのですが、 毎日網掛けになってしまいます。 どうぞよろしくおねがいいたします。
A1セルの条件付書式を「数式が」で「=WEEKDAY($A1)=1」として、書式設定（日曜日） 条件2には同様にして、「=WEEKDAY($A1)=7」として書式設定（土曜日） あとは、目的の場所まで書式コピー です。 WEEKDAY関数では、日、月、火・・・土の順番に1、2、3・・・7が返ってきます。 (ROUGE)
土日限定ならこれで良いです。 =IF(WEEKDAY(A1,2)>5,"土日","平")
条件付書式で使うなら（数式がで） =WEEKDAY(A1,2)>5
他祝日振替については、別に祝日表を作っておいて検索日をMATCH関数やCOUNTIFで確認すれば言いと思います。 http://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=37;id=FAQ (Jaka)
ばっちりできました。本当にありがとうございました。
Jaka様：
お返事ありがとうございます。 =IF(WEEKDAY(A1,2)>5,"土日","平") この数式は条件付書式で使うのでしょうか？？ 祝日のところもこれから読んでやってみます。
よろしくおねがいいたします。
追加で質問なんですが、実はE1には何時間就業したかを入れるセルがあるんです。 そこで条件付書式設定を使っているのでできれば、条件付書式を使いたくないのです が可能ですか？@evian
とりあえず・・・
あいかわらず、祭日無視ですが(^^;;
-----
Public Sub TEST()
Dim i As Integer
Dim myR As Integer
myR = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To myR
Select Case Cells(i, 2)
Case "日"
With Range(Cells(i, 1), Cells(i, 5))
.Interior.ColorIndex = 38
.Font.ColorIndex = 3
End With
Case "土"
With Range(Cells(i, 1), Cells(i, 5))
.Interior.ColorIndex = 34
.Font.ColorIndex = 5
End With
End Select
Next
End Sub
----
(ROUGE)
すごいですね!ありがとうございます。
もうちょっと教えてください。これだと、網掛けの色がピンクと水色ですよね。 色は白のままでいいんですが、パターンで一番粗い水玉にしたいのですが、 どこを直すのでしょうか？ @evian
初期化のコードを忘れていました。
水玉がどれか良く分かりませんでしたが、とりあえず。
----
Public Sub TEST()
Dim i As Integer
Dim myR As Integer
myR = Range("A" & Rows.Count).End(xlUp).Row
With Range(Cells(1, 1), Cells(myR, 5)) '以下4行追加
.Interior.Pattern = xlNone
.Font.ColorIndex = 0
End With
For i = 1 To myR
Select Case Cells(i, 2)
Case "日"
With Range(Cells(i, 1), Cells(i, 5))
.Interior.Pattern = xlGray8 'ここを変えました。
.Font.ColorIndex = 3
End With
Case "土"
With Range(Cells(i, 1), Cells(i, 5))
.Interior.Pattern = xlGray8 'ここも変えました。
.Font.ColorIndex = 5
End With
End Select
Next
End Sub
----
(ROUGE)
ばっちりでした。網掛けも指定したものであってました。 感謝感激ですm(__)m。ほんとにありがとうございます！
マクロができると便利なんですね。勉強した方がよさそうですね。
また助けて下さい。よろしくおねがいいたします。@evian
もう見ていないかも知れませんが、祭日対応しました。
今年から祝日法が改正されない限り2099年まで対応です。
-------
Public Sub TEST()
Dim i As Integer
Dim myR As Integer
Dim myY As Integer, myM As Integer, myD As Integer
myR = Range("A" & Rows.Count).End(xlUp).Row
With Range(Cells(1, 1), Cells(myR, 5))
.Interior.Pattern = xlNone
.Font.ColorIndex = 0
End With
Columns("F:F").ClearContents
For i = 1 To myR
Select Case Cells(i, 2)
Case "日"
With Range(Cells(i, 1), Cells(i, 5))
.Interior.Pattern = xlGray8
.Font.ColorIndex = 3
End With
Case "土"
With Range(Cells(i, 1), Cells(i, 5))
.Interior.Pattern = xlGray8
.Font.ColorIndex = 5
End With
End Select
myY = Year(Cells(i, 1))
myM = Month(Cells(i, 1))
myD = Day(Cells(i, 1))
With Range(Cells(i, 1), Cells(i, 5))
Select Case myM
Case 1
Select Case myD
Case 1
Cells(i, 6).Value = "元旦"
.Interior.Pattern = xlGray8
.Font.ColorIndex = 3
If Cells(i, 2) = "日" Then
Range(Cells(i + 1, 1), Cells(i + 1, 5)).Interior.Pattern = xlGray8
Range(Cells(i + 1, 1), Cells(i + 1, 5)).Font.ColorIndex = 3
Cells(i + 1, 6).Value = "振替休日"
End If
Case 8, 9, 10, 11, 12, 13, 14
If Cells(i, 2) = "月" Then
Cells(i, 6) = "成人の日"
.Interior.Pattern = xlGray8
.Font.ColorIndex = 3
End If
End Select
Case 2
If myD = 11 Then
Cells(i, 6) = "建国記念の日"
.Interior.Pattern = xlGray8
.Font.ColorIndex = 3
If Cells(i, 2) = "日" Then
Range(Cells(i + 1, 1), Cells(i + 1, 5)).Interior.Pattern = xlGray8
Range(Cells(i + 1, 1), Cells(i + 1, 5)).Font.ColorIndex = 3
Cells(i + 1, 6).Value = "振替休日"
End If
End If
Case 3
If myD = Int(20.8431 + 0.242194 * (myY - 1980)) - Int((myY - 1980) / 4) Then
Cells(i, 6) = "春分の日"
.Interior.Pattern = xlGray8
.Font.ColorIndex = 3
If Cells(i, 2) = "日" Then
Range(Cells(i + 1, 1), Cells(i + 1, 5)).Interior.Pattern = xlGray8
Range(Cells(i + 1, 1), Cells(i + 1, 5)).Font.ColorIndex = 3
Cells(i + 1, 6).Value = "振替休日"
End If
End If
Case 4
If myD = 29 Then
Cells(i, 6) = "みどりの日"
.Interior.Pattern = xlGray8
.Font.ColorIndex = 3
If Cells(i, 2) = "日" Then
Range(Cells(i + 1, 1), Cells(i + 1, 5)).Interior.Pattern = xlGray8
Range(Cells(i + 1, 1), Cells(i + 1, 5)).Font.ColorIndex = 3
Cells(i + 1, 6).Value = "振替休日"
End If
End If
Case 5
Select Case myD
Case 3
Cells(i, 6).Value = "憲法記念日"
.Interior.Pattern = xlGray8
.Font.ColorIndex = 3
If Cells(i, 2) = "日" Then
Range(Cells(i + 3, 1), Cells(i + 3, 5)).Interior.Pattern = xlGray8
Range(Cells(i + 3, 1), Cells(i + 3, 5)).Font.ColorIndex = 3
Cells(i + 3, 6).Value = "振替休日"
End If
Case 4
Cells(i, 6).Value = "国民の休日"
.Interior.Pattern = xlGray8
.Font.ColorIndex = 3
If Cells(i, 2) = "日" Then
Range(Cells(i + 2, 1), Cells(i + 2, 5)).Interior.Pattern = xlGray8
Range(Cells(i + 2, 1), Cells(i + 2, 5)).Font.ColorIndex = 3
Cells(i + 2, 6).Value = "振替休日"
End If
Case 5
Cells(i, 6).Value = "こどもの日"
.Interior.Pattern = xlGray8
.Font.ColorIndex = 3
If Cells(i, 2) = "日" Then
Range(Cells(i + 1, 1), Cells(i + 1, 5)).Interior.Pattern = xlGray8
Range(Cells(i + 1, 1), Cells(i + 1, 5)).Font.ColorIndex = 3
Cells(i + 1, 6).Value = "振替休日"
End If
End Select
Case 6
Case 7
Select Case myD
Case 15, 16, 17, 18, 19, 20, 21
If Cells(i, 2) = "月" Then
Cells(i, 6) = "海の日"
.Interior.Pattern = xlGray8
.Font.ColorIndex = 3
End If
End Select
Case 8
Case 9
Select Case myD
Case 15, 16, 17, 18, 19, 20, 21
If Cells(i, 2) = "月" Then
Cells(i, 6) = "敬老の日"
.Interior.Pattern = xlGray8
.Font.ColorIndex = 3
End If
End Select
If myD = Int(23.2488 + 0.242194 * (myY - 1980)) - Int((myY - 1980) / 4) Then
Cells(i, 6) = "秋分の日"
.Interior.Pattern = xlGray8
.Font.ColorIndex = 3
If Cells(i, 2) = "日" Then
Range(Cells(i + 1, 1), Cells(i + 1, 5)).Interior.Pattern = xlGray8
Range(Cells(i + 1, 1), Cells(i + 1, 5)).Font.ColorIndex = 3
Cells(i + 1, 6).Value = "振替休日"
End If
End If
Case 10
Select Case myD
Case 8, 9, 10, 11, 12, 13, 14
If Cells(i, 2) = "月" Then
Cells(i, 6) = "体育の日"
.Interior.Pattern = xlGray8
.Font.ColorIndex = 3
End If
End Select
Case 11
Select Case myD
Case 3
Cells(i, 6).Value = "文化の日"
.Interior.Pattern = xlGray8
.Font.ColorIndex = 3
If Cells(i, 2) = "日" Then
Range(Cells(i + 1, 1), Cells(i + 1, 5)).Interior.Pattern = xlGray8
Range(Cells(i + 1, 1), Cells(i + 1, 5)).Font.ColorIndex = 3
Cells(i + 1, 6).Value = "振替休日"
End If
Case 23
Cells(i, 6).Value = "勤労感謝の日"
.Interior.Pattern = xlGray8
.Font.ColorIndex = 3
If Cells(i, 2) = "日" Then
Range(Cells(i + 1, 1), Cells(i + 1, 5)).Interior.Pattern = xlGray8
Range(Cells(i + 1, 1), Cells(i + 1, 5)).Font.ColorIndex = 3
Cells(i + 1, 6).Value = "振替休日"
End If
End Select
Case 12
If myD = 23 Then
Cells(i, 6) = "天皇誕生日"
.Interior.Pattern = xlGray8
.Font.ColorIndex = 3
If Cells(i, 2) = "日" Then
Range(Cells(i + 1, 1), Cells(i + 1, 5)).Interior.Pattern = xlGray8
Range(Cells(i + 1, 1), Cells(i + 1, 5)).Font.ColorIndex = 3
Cells(i + 1, 6).Value = "振替休日"
End If
End If
End Select
End With
Next
End Sub
-------
(ROUGE)
あ、E列には何か入っているんですよね。 祝日名をE列に配置してしまいました。 ご注意下さい。 (ROUGE)
F列でした。(^-^;; (ROUGE)
おはようございます。こんなにしていただきまして、 ほんとうにありがとうございました。 試してみてからまた連絡させていただきます。 とりいそぎお礼までm(__)m @evian
できました！ほんとうに何と言ってお礼を言っていいのか思い当たりません。 毎月100人近くにﾌｫｰﾑをmailしてたのですが、 これからは各自自分で更新してもらうようにします。 本当にありがとうございます。 また助けて下さい！よろしくおねがいいたします。@evian
>今年から祝日法が改正されない限り2099年まで対応です。 つっこみです。 国民の休日が中途半端です。
名無しさんへ
つっこみありがとうございます。
祝日法の改正（昭和の日、みどりの日）を忘れていました(^^;;
"今年から"限定で・・・。
4月29日と5月4日を次のとおり修正して下さい。
-----
Case 4
If myD = 29 Then
If myY < 2007 Then
Cells(i, 6).Value = "みどりの日"
Else
Cells(i, 6).Value = "昭和の日"
End If
.Interior.Pattern = xlGray8
.Font.ColorIndex = 3
If Cells(i, 2) = "日" Then
Range(Cells(i + 1, 1), Cells(i + 1, 5)).Interior.Pattern = xlGray8
Range(Cells(i + 1, 1), Cells(i + 1, 5)).Font.ColorIndex = 3
Cells(i + 1, 6).Value = "振替休日"
End If
End If
Case 5
Select Case myD
・
・
・
Case 4
If myY < 2007 Then
Cells(i, 6).Value = "国民の休日"
Else
Cells(i, 6).Value = "みどりの日"
End If
.Interior.Pattern = xlGray8
.Font.ColorIndex = 3
If Cells(i, 2) = "日" Then
Range(Cells(i + 2, 1), Cells(i + 2, 5)).Interior.Pattern = xlGray8
Range(Cells(i + 2, 1), Cells(i + 2, 5)).Font.ColorIndex = 3
Cells(i + 2, 6).Value = "振替休日"
End If
Case 5
・
・
・
-------
(ROUGE)
>祝日法の改正（昭和の日、みどりの日）を忘れていました(^^;; それもあるだろうけど、もっと大事なことが抜けているようです。 ソートしてないけど。
Sub 祝日()
Dim HoriTB As Variant, SchYear As Long, Nen As Long
Nen = 2009
HoriTB = HolidayTBL(Nen)
Columns("A").ClearContents
'Range("A1").Resize(UBound(HoriTB) + 1).NumberFormatLocal = "@"
Range("A1").Resize(UBound(HoriTB) + 1).Value = Application.Transpose(HoriTB)
Erase HoriTB
End Sub
Private Function HolidayTBL(Nen As Long) As Variant Dim FixHoliday As Variant, SachYear As Long, WekDy As Long Dim Anp As Variant, CagJan As Long, CagJul As Long, CagSep As Long Dim Equx39 As Long
'SachYear = 2006 SachYear = Nen
FixHoliday = Array("1/1", "2/11", "4/29", "5/3", "5/4", "5/5", _
"11/3", "11/23", "12/23")
For i = 0 To UBound(FixHoliday)
FixHoliday(i) = SachYear & "/" & FixHoliday(i)
Next
WekDy = WeekDay(SachYear & "/1/1", vbSunday)
If WekDy <= 2 Then
CagJan = 2 - WekDy + ((2 - 1) * 7) + 1
Else
CagJan = 8 - WekDy + ((2 - 1) * 7) + 2
End If
ReDim Preserve FixHoliday(UBound(FixHoliday) + 1)
FixHoliday(UBound(FixHoliday)) = SachYear & "/1/" & CagJan
WekDy = WeekDay(SachYear & "/7/1", vbSunday)
If WekDy <= 2 Then
CagJul = 2 - WekDy + ((3 - 1) * 7) + 1
Else
CagJul = 8 - WekDy + ((3 - 1) * 7) + 2
End If
ReDim Preserve FixHoliday(UBound(FixHoliday) + 1)
FixHoliday(UBound(FixHoliday)) = SachYear & "/7/" & CagJul
WekDy = WeekDay(SachYear & "/9/1", vbSunday)
If WekDy <= 2 Then
CagSep = 2 - WekDy + ((3 - 1) * 7) + 1
Else
CagSep = 8 - WekDy + ((3 - 1) * 7) + 2
End If
ReDim Preserve FixHoliday(UBound(FixHoliday) + 1)
FixHoliday(UBound(FixHoliday)) = SachYear & "/9/" & CagSep
WekDy = WeekDay(SachYear & "/10/1", vbSunday)
If WekDy <= 2 Then
CagOct = 2 - WekDy + ((2 - 1) * 7) + 1
Else
CagOct = 8 - WekDy + ((2 - 1) * 7) + 2
End If
ReDim Preserve FixHoliday(UBound(FixHoliday) + 1)
FixHoliday(UBound(FixHoliday)) = SachYear & "/10/" & CagOct
ReDim Preserve FixHoliday(UBound(FixHoliday) + 1)
Equx39 = Fix(20.8431 + 0.242194 * _
(SachYear - 1980) - Fix((SachYear - 1980) / 4))
FixHoliday(UBound(FixHoliday)) = SachYear & "/3/" & Equx39
ReDim Preserve FixHoliday(UBound(FixHoliday) + 1)
Equx39 = Fix(23.2488 + 0.242194 * _
(SachYear - 1980) - Fix((SachYear - 1980) / 4))
FixHoliday(UBound(FixHoliday)) = SachYear & "/9/" & Equx39
If WeekDay(DateValue(SachYear & "/9/" & Equx39), vbSunday) = 4 Then
ReDim Preserve FixHoliday(UBound(FixHoliday) + 1)
FixHoliday(UBound(FixHoliday)) = SachYear & "/9/" & Equx39 - 1
End If
HolidayTBL = FixHoliday Erase FixHoliday End Function (Jaka)
EXCELの技法とは直接関係ありませんが、私もかつて数年先のカレンダーを作ろうとして
祭日(国民の休日?)の扱いについて調べた事があります。
その中でも、特に春分の日/秋分の日の部分では下記の内容があり
「こりゃあ、せいぜい 2〜3年先までしか作られんな・・」と思ってしまいました。
その要点は
・計算で春分点、秋分点は求められる が
・閣議で承認されてその年(翌年)の、春分の日や秋分の日が決まる
(とは言え、ほとんどその計算通りになるが・・)
・おまけに、月曜日を休みにして連休を増やそう・・みたいな動きがある
(もっと言えば、政府の気まぐれで祭日がコロコロ変わる)
ですので、予測でカレンダーを作っておき、簡単に修正が出来る様にしておきました。
（evian）さんも多少の網掛け修正が必要になるかもしれませんね・・
http://koyomi.vis.ne.jp/directjp.cgi?http://koyomi.vis.ne.jp/syunbun.htm
↑ を参照下さい。
(caro) 2006.02.24 12:30 ゴッツンコしたので12:30のまま再送です
あ 敬老の日と秋分の日の間の国民の休日を忘れていましたね・・・ Jakaさん、ご指摘ありがとうございます。 あやうく1日休みを減らしてしまうところでした。 (ROUGE)
なんだかいろいろありがとうございます。 追加でご相談させてください。今まではA1からシートを作っていたのですが、 来月から1から5行目は名前や部署なんかを入力する行を挿入しようかと思うんです。 セルの結合なんかをするとダメだと思うんですが、もしセルの結合 を使った場合、A6からはじめるとしたら、マクロの中身をみても何もわからないので どこを訂正すればいいのか ROUGEさん、Jakaさん、教えてください。 休日の名前は表示されなくってもどちらでもいいです。
＠evian
とりあえず、9月の国民の休日の修正。
--------
・
・
・
Case 9
If myD = 23 - weekday(myY & "/9/1", vbMonday) Then 'And Cells(i, 2).Value = "月" Then
Cells(i, 6).Value = "敬老の日"
.Interior.Pattern = xlGray8
.Font.ColorIndex = 3
End If
If Cells(i, 2).Value = "火" And myD + 1 = Int(23.2488 + 0.242194 * (myY - 1980)) - Int((myY - 1980) / 4) Then
Cells(i, 6).Value = "国民の休日"
.Interior.Pattern = xlGray8
.Font.ColorIndex = 3
End If
If myD = Int(23.2488 + 0.242194 * (myY - 1980)) - Int((myY - 1980) / 4) Then
Cells(i, 6) = "秋分の日"
.Interior.Pattern = xlGray8
.Font.ColorIndex = 3
If Cells(i, 2) = "日" Then
Range(Cells(i + 1, 1), Cells(i + 1, 5)).Interior.Pattern = xlGray8
Range(Cells(i + 1, 1), Cells(i + 1, 5)).Font.ColorIndex = 3
Cells(i + 1, 6).Value = "振替休日"
End If
End If
・
・
・
--------
追加の質問について
私のコードであれば、
> With Range(Cells(6, 1), Cells(myR, 5)) ' ~ここを1から6に変更
>For i = 6 To myR ' ~ここを1から6に変更
です。 (ROUGE)
ここもでした。
>Columns("F:F").ClearContents
↓
Range("F6:F" & Rows.Count).ClearContents
に変更
(ROUGE)
あと、日付を入れるときに
A6 =DATE(2006,E1,1) E1に月を入力する B6 =TEXT(A6,"AAA")
に変えようかと思うんですが、そうすると上のマクロにエラーがでますか？
@evian
多分大丈夫ですよ。 色々不備がありましたが、なんとかここまでこぎつけて一安心です。(^-^) ところで、evianさんの提示のような場合、2,4,6,9,11月は31日までありませんが、 どうされますか？ いっそのこと、年と月を入れたらその月のシートを作るコードを組んでしまってはいかがですか？ (ROUGE)
はい。実は31日の件でどうしようか格闘中でした。 条件付き書式を指定しても網掛けはのこっちゃうしとか・・・。 大変うれしいご指摘でした。ありがとうございました。
いっそのこと、年と月を入れたらその月のシートを作るコードを組んでしまってはいかがですか？
こんなことできますか？
できますよ。 でも、このスレもかなり長くなっているので・・・ (ROUGE)
evianさん
A1セルに年、B1セルに月として組んでみました。
--------
Sub Sample()
Dim myY As Integer, myM As Integer, myD As Integer
Dim myDate As Date
Dim i As Integer
Range("A6:B36").ClearContents
myY = Range("A1").Value
myM = Range("B1").Value
myD = Day(DateSerial(myY, myM + 1, 1) - 1)
For i = 1 To myD
myDate = DateSerial(myY, myM, i)
With Range("A" & i + 5)
.Value = myDate
.NumberFormatLocal = "d"
End With
Range("B" & i + 5).Value = Application.WorksheetFunction.Text(myDate, "aaa")
Next
End Sub
--------
(ROUGE)
ありがとうございました！ たくさんマクロを作ってくださいまして、本当に感謝しております。 とりあえず、いろいろ試行錯誤してどれを使うか考えて見ます！ 3月分については、土、日のみに網掛けがかかるマクロを使いたいと思っています。 また困ったらご相談させていただきます。 長きにわたり、ありがとうございました。＠evian
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.