[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『入退室管理を行いたいと思っています。』(NaNo)
小さな塾の自習室で入退出管理を行いたいと思っています。
■Sheet構成
(1)「生徒マスター」
(2)「base」
(3)日付シート(どんどん増えます)
(1)のシートには生徒名と個々のID
(2)は(3)の元となるシートで、入退室を管理する表(※1)が空の状態で作ってあります。マクロでその日の日付をシート名にした(3)のシートが追加されるようにしてあり、実際の入退室時間の記録は(3)のシートに行います。
■※1の入退室を管理する表
A | B | C | D | E | ・・・ | G | 1 生徒ID | 生徒名 | 入室時間 | 退室時間 | 滞在時間 | ・・・ |[検索値]| 2 000001 |AB CD | 14:20 | 15:00 | (D) -(C) | ・・・ |[ 空欄 ]| 3 000005 |fB CR | 14:50 | 16:10 | (D) -(C) | ・・・ |[ 空欄 ]| 4 000018 |SE WO | 17:02 | 18:00 | (D) -(C) | ・・・ |[ 空欄 ]|
上記のような感じで、生徒の成績管理表に貼ったバーコードをリーダーで読みこむとA列に生徒IDが入ます。このシートにはPrivate Sub Worksheet_Changeを使って、A列に値が入ると、B列に「生徒マスター」から参照した生徒名、C列に現在日時が入るようにしてあります。
ここまでは問題なく動いており、すでに使用しています。
ただ、退室時間を自動で入れるのは難しそうだなーと思い、現在のところ退室時間は該当する子のD列を選んでからタイムスタンプのマクロを設定したボタンを押して入力しているのですが、それも自動で(バーコードリーダーで読んで)できるといいな〜と思い、やってみたのですが。。。うまくいきません。
まず、A列に新しく入力された値がすでにあった場合、該当する行のD列に現在日時を入れ、最終行のA列とC列をクリアするというマクロ(Taishitsu)を書いて試してみたところ思い通りに動いたのですが、「A列に値が入ったら」マクロを走らせたいので、前述のPrivate Sub Worksheet_Changeの日付を入れる動作の後にマクロを呼び出してみたら、エラーとなりました。しかも、この後、もう一度Taishitsuマクロを単独で動かそうとしても、やはりエラーになってしまいます。
(いったんExcelを閉じて、再度Taishitsu単独で動かすと動きます。でも、Worksheet_Changeに入れ込むとやはりエラー。その後Taishitsu単独でもエラーです)
どこが悪いのか・・・いろいろ検索したのですがわからず、途方に暮れています。ご教授いただけますと幸いです。よろしくお願いいたします。
↓標準モジュールに記述
Sub Taishitsu()
'最終行のA列と同じ値の行をA列で検索し、同じものがあったら該当する行のD列に日時を入れ、最終行のA〜CをClear
Dim txt As String Dim rng As Range Dim row_num As Long
'セルG1に関数(INDEX(A:A,COUNTA(A:A))で最終行のA列の値を表示しているので、これを検索値とする
txt = Range("G1").Value '最終行を取得 last = Cells(Rows.Count, "A").End(xlUp).Row
'A2から最終行の1行前まで検索
Set rng = Range(Range("A2"), Range("A2").End(xlDown).Offset(-1, 0)).Find(What:=txt) '見つかったら、該当する行のD列に日時を入れ、最終行のA列とC列を消す If Not rng Is Nothing Then row_num = rng.Row Cells(row_num, 4) = Now Cells(last, 1).ClearContents Cells(Rows.Count, "C").End(xlUp).ClearContents End If End Sub
↓シートモジュールに記述
Private Sub Worksheet_Change(ByVal Target As Range)
'a列に入力があるとc列に入力日付時間を自動挿入します
If Target.Column = 1 Then
If Cells(Target.Row, 1).Value <> "" Then Status = Now Else Status = ""
If TypeName(Target.Value) <> "Variant()" Then Cells(Target.Row, 3).Value = Now Else _
Taishitsu '←これが入るとエラーになります LastRow '最終行の次の行のA列をSelectするマクロです End Sub
< 使用 Excel:Office365、使用 OS:Windows10 >
本当に、本当にありがとうございました。
(NaNo) 2021/11/17(水) 23:37
Private Sub Worksheet_Change(ByVal Target As Range) 'A列最終行に入力があるとC列に入力日付時間を自動挿入します If Target.Address = Cells(Rows.Count, "A").End(xlUp).Address Then Dim rng As Range '※最終データを探すため最終行の次の行から上方向に検索 Set rng = Range("A2", Target).Find(What:=Target.Value, _ After:=Target, _ LookIn:=xlValues, _ LookAt:=xlWhole, _ SearchDirection:=xlPrevious) '※D列に値が入力されていたら前回利用終了しているため新規使用開始と見なす If rng.Row < Target.Row And rng.Offset(, 3).Value = "" Then '使用終了処理 rng.Offset(, 3).Value = Now 'D列に現在日時を入力 Application.EnableEvents = False Target.ClearContents '最終行に入力されたA列の値を消去 Application.EnableEvents = True Else '使用開始処理 If Target.Value <> "" Then Target.Offset(, 1).FormulaR1C1 = Range("H2").FormulaR1C1 Target.Offset(, 2).Value = Now End If End If '最終行の次の行のA列をSelect Cells(Rows.Count, "A").End(xlUp).Offset(1).Select End If End Sub
同一IDの人が複数回利用する時に困りそうかも?、と思いおまけを作りました。
(きまぐれおじさん) 2021/11/18(木) 09:35
「おまけ」を作ってくださったんですね。レスが遅くなり、大変失礼しました。
素晴らしいです。いろいろと勉強になります。ありがとうございました!
(NaNo) 2021/11/20(土) 17:17
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.