【VBA】暇だったのでexcelで勤怠管理表を作ってみた
この前、大学生の子にExcelの関数を教えてあげたんですよ。
なんでも課題がだされたみたいでして。
内容は単純に関数を使用して条件を満たすデータを抽出したりするものだったんですけど、久しぶりにやると楽しいですよね。
Excelに限らずなんですけど問題を解くのって楽しくて震えます。
こんばんは、えこです。
今回は暇だったのでシリーズ第2弾です。
VBAを使って勤怠管理表を作ってみました!
汚いコードなんですけどもし使うようだったら手直しして使ってやってください。
暇だったのでシリーズ第1弾はこちら
作ったもの
作ったものをYouTubeにアップしました。
動画ではだいぶ説明端折っているのでこっちで詳しく解説していきます。
仕様書
このExcelは出勤と退勤の時刻を打刻するものです。
まず、シート(スタッフ)のB5からスタッフの名前を入力していきます。
今回は例として乃木坂メンバー5人をスタッフとして入力しています。
次にシート(出勤表)に移動し、スタッフ反映ボタンを押します。
するとI2:R34にスタッフ名と罫線が引かれ表が作成されます。
表が作成されたらB4のドロップダウンリストから名前を選択します。
あとは出勤、退勤ボタンを押すことで現在の時刻が打刻されます。
出勤ボタンを押すときに間違って他の人の名前で出勤してしまった場合の救済処置が必要です。
VBAで入力された内容は戻るボタンでは戻れません。
なのでバックアップ機能が必要になります。
今回は出勤ボタンを押すと初めに現状をコピーしてシー(バックアップ)にまるまるコピーする機能をつけました。
あと、時間を書き換えられないようにシートの保護もされています。
他にも、例えば出勤してい状態で退勤ボタンを押すとメッセージが表示されるギミックもあります。
なぜかはてなブログでgifが上げられなかったのでTwitterで上げようか。
— えこ@ (@htmllifehack) 2019年5月5日
VBAで勤怠管理 pic.twitter.com/3gSYAc2yIv
コードの説明
前回のように作ったものの紹介とコードの説明の2回に分けようと思ったんですけど
そんなにコードの量もないのでまとめちゃいますかね。
入力されたセルの数を数えるVBA
まずはスタッフ反映ボタンの説明です。
シート(スタッフ)に入力されたメンバーの名前をシート(出勤表)に反映させる必要があります。
'sheet("スタッフ")に入力されている人数をカウント '出勤と退勤があるので数値を2倍に増やす last_column = Worksheets("スタッフ").Cells(4, 2).End(xlDown).row * 2 '日付をカウント last_row = Worksheets("出勤表").Cells(2, 7).End(xlDown).row
End(xlDown)
はctrl + End
の機能を使うさいに用います。
表の1番上の行のセルにカーソルを合わせてctrl + endを押すと値が入力されているセルの1番したに移動します。
シート(出勤表)で言えば、H3の曜日をセレクトした状態でctrl+endを押すとH34の金に移動できます。
End(xlDown)
だとセルに入力された値を取得してしまうので.row
をつけることで行番号を取得します。
つまり変数last_column
にはシート(スタッフ)のB4から下に数えていって最後に値が入力されているセルまでの列番号が入ります。
で、1人につき出勤と退勤の2つの情報を入力する必要があるので×2をします。
この例でいえばlast_columnには10が代入されます。
変数last_rowも一緒でG列の値が入力されている最後の行番号を代入しています。
セルの結合と中央揃えと罫線をVBAで
セル番地.Merge
でセルの結合、unmergeで結合解除です。
セル番地.HorizontalAlignment = xlCenter
で中央揃え
セル番地.Borders.LineStyle = xlContinuous
で格子罫線を引けます。
今回は同じセルに結合と中央揃えと罫線の設定を行うのでset
を使ってまとめて指定します。
c = 0 For i = 4 To member_last_row Set member_cell = Range(Cells(2, 9 + c), Cells(2, 9 + c + 1)) member_cell.Merge member_cell.HorizontalAlignment = xlCenter member_cell.Borders.LineStyle = xlContinuous Cells(2, 9 + c).value = Worksheets("スタッフ").Cells(i, 2) c = c + 2 Next i
3行目のRange(Cells(2, 9 + c), Cells(2, 9 + c + 1))
はシート(出勤表)のI2:J2を示しています。
cells(2,9)がI2のことで、+1することでJ2を指定しています。
cellsはcells(縦、横)で指定します。
4,5,6行目でI2:J2を結合、中央揃え、罫線を引きます。
7行目でシート(スタッフ)に入力されている値をI2に反映しています。
これをメンバーの数だけ繰り返すので変数cを用意してセルを横に2つ移動させて次のメンバーの設定に入ります。
for2週目はcells(2,11)、つまりK2:L2に2人目の名前を入力していくようになっています。
ほかに、出勤退勤の文字をI3:J3に表示するようにします。
c2 = 0 For j = 4 To member_last_row Set start_cell = Cells(3, 9 + c2) start_cell.Value = "出勤" start_cell.HorizontalAlignment = xlCenter start_cell.Borders.LineStyle = xlContinuous Set leaving_cell = Cells(3, 10 + c2) leaving_cell.Value = "退勤" leaving_cell.HorizontalAlignment = xlCenter leaving_cell.Borders.LineStyle = xlContinuous c2 = c2 + 2 Next j
やっていることは一緒ですね。
で、最後に全体を罫線で囲って反映ボタンのコードは完成です。
days_last_row = Cells(3, 7).End(xlDown).row '34 Range(Cells(2, 9), Cells(days_last_row, (member_last_row - 3) * 2 + 8)).Borders.LineStyle = xlContinuous
値が一致した場合のみ処理を実行するVBA
次に出勤ボタンのと退勤ボタンの説明です。
B4の値と今日の日付が一致した場合のみ現在時刻を打刻するような仕掛けが必要です。
'B4のスタッフ名と一致する列を検索 For i = 0 To last_column + 1 If Cells(2, i + 9) = Range("b4") Then mem = i + 9 End If Next i '今日の日付と一致する行を検索 For k = 0 To 31 If Cells(4 + k, 7) = Range("a2") Then days = 4 + k End If Next k '現在の時刻を打刻 Cells(days, mem) = Format(Time, "hh:mm:ss"))
最初のfor
でB4の名前と一致するかどうかを2行目のスタッフから検索します。
一致した場合その行番号を変数memに代入します。
2つ目のforでtoday関数と一致するかG列の日付から検索します。
一致した場合その列番号を変数daysに代入します。
cells(days,mem)のセル番地に現在の時刻を打刻します。
Time
で現在時刻を表示し、それをFormatで囲むことで表示形式を指定できます。
これで出勤ボタンのコードが完成です。
退勤ボタンのコードもほぼ一緒です。
For i = 0 To last_column If Cells(2, i + 9) = Range("b4") Then mem = i + 9 + 1 End If Next i For k = 0 To 31 If Cells(3 + k, 7) = Range("a2") Then days = 3 + k End If Next k Cells(days, mem) = Format(Time, "hh:mm:ss")
出勤時刻を打刻するセルの一つ右隣りに退勤時刻を打刻する必要があるので一つ目のforで+1をしています。
セルの値を削除し元通りに戻すVBA
最後にクリアボタンです。
結合から戻したり、罫線を消したりします。
Set member_cell = Worksheets("出勤表").Range(Cells(2, 9), Cells(last_row, last_column * 2 + 10)) member_cell.UnMerge member_cell.Borders.LineStyle = xlLineStyleNone Worksheets("出勤表").Range(Cells(2, 9), Cells(last_row, last_column * 2 + 10)).ClearContents
先に話したとおりセルの結合を解除する場合はセル番地.UnMerge
でできます。
罫線の削除はセル番地.Borders.LineStyle = xlLineStyleNone
です。
値を削除する場合はClearContents
です。
他にもセル番地.value = ""
でもいけますね。
おまけ
基本的な部分はこれでおわりですが、メッセージが表示されたり、シートの保護やセルのロックなどの機能もつけたので、せっかくだしそのあたりも紹介しようかな。
バックアップに関してはただコピーして他のシートに張り付けしているだけなのであえて書く必要もないんですけど、コピーしたときの選択を解除するコードがあるのでそこだけ書きますかね。
シートの保護とセルのロックをVBAで
Cells.locked = True
ですべてのセルをロックできます。
セル番地.locked = False
でロックを解除できます。
シート名.Protect
でシートの保護ができます。
シート名.Unprotect
でシートの保護を解除します。
スタッフ反映ボタンと出勤、退勤ボタンのコードの一番最初にシートの保護解除とセルのロック解除コードを書き込みます。
真ん中に先に書いたセルの結合やら罫線やらのコードを書き込み、最後にセルのロックとシートの保護コードを書き込みます。
これでボタンの実行中は値を入力できますが、処理が終わったあとに手動で時間を入力することはできなくなります。
ちなみに今回はシートの保護にパスワードはかけていません。
パスワードをかけるときはProtect Password:="
好きなパスワードを入力"`でできます。
Msgboxでyes,noを選択する
メッセージボックスでYes、Noを表示させて選択によって異なる処理を実行させたいと思います。
Yes, Noを表示させるにはMsgBox("彼女は齋藤飛鳥ですか?", vbYesNo)
のように書きます。
Sub clear() msg = MsgBox("クリアしますか?", vbYesNo) If msg = vbYes Then 'シートの保護とセルのロックを解除する Worksheets("出勤表").Unprotect Cells.locked = False last_column = Worksheets("スタッフ").Cells(4, 2).End(xlDown).row - 3 last_row = Cells(2, 7).End(xlDown).row Set member_cell = Worksheets("出勤表").Range(Cells(2, 9), Cells(last_row, last_column * 2 + 10)) member_cell.UnMerge member_cell.Borders.LineStyle = xlLineStyleNone Worksheets("出勤表").Range(Cells(2, 9), Cells(last_row, last_column * 2 + 10)).ClearContents Worksheets("バックアップ").Select Set member_cell_b = Worksheets("バックアップ").Range(Cells(2, 9), Cells(last_row, last_column * 2 + 10)) member_cell_b.UnMerge member_cell_b.Borders.LineStyle = xlLineStyleNone Worksheets("バックアップ").Range(Cells(2, 9), Cells(last_row, last_column * 2 + 10)).ClearContents Worksheets("出勤表").Range("b4").Value = "" Worksheets("出勤表").Select 'シートの保護とセルのロックを行う Cells.locked = True Range("b4:e6").locked = False Worksheets("出勤表").Protect Else MsgBox "処理はキャンセルされました" End If End Sub
クリアボタンの全体はこんな感じになっています。
もしYesを選択した場合はクリアを実行し、そうでない場合は処理はキャンセルされたとメッセージが表示されるようになっています。
まとめ
いかがだったでしょうか。
暇なときに仕事の合間に作っていました(笑)
家では絶対にやりたくないですね(笑)
なので期間は結構かかりましたがわからないコードも検索すればでてくる時代なのでそこまで苦労せずに完成できました。
全体のコードは最後に乗せておきますがExcelデータ自体は実用化できるか不明なのでアップしていません。
ってことで今回はVBAで遊んでみましたが、次はpythonを使ってなにかしていきたいと思います。
面白そうだなって思うことを見つけたので(笑)
そんな感じで今回は以上です、それではまたお会いしましょう。
ばいばい