[[20211117222807]] 『入退室管理を行いたいと思っています。』(NaNo) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『入退室管理を行いたいと思っています。』(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 _

For i = 0 To UBound(Target.Value) - 1
Cells(Target.Row + i, 3).Value = Now: Next
If Cells(Target.Row, 1).Value <> "" Then Cells(Target.Row + i, 2).FormulaR1C1 = Range("h2").FormulaR1C1
End If
    Taishitsu 		'←これが入るとエラーになります
    LastRow		'最終行の次の行のA列をSelectするマクロです		
End Sub

< 使用 Excel:Office365、使用 OS:Windows10 >


ちゃんと見ていませんが、ざっと見て、taishitsuマクロでA列の値をclearcontentsしているので
そこからまたchangeイベントが発生して永遠に終わらないマクロになりそうな予感はします。
Application.EnableEventsでイベント抑制するとどうなるかをまず見てみてください。
(きまぐれおじさん) 2021/11/17(水) 22:49

きまぐれおじさん様
すごいです!ほぼ1日悩んでたんですが、Application.EnableEventsでイベント制御してみたら、思った通りの挙動になりました!!
そっか〜。。。Changeイベントが終わらない状態になっちゃってたんですね。
コロナ禍で生徒の滞在時間が長くなりすぎないようチェックするための表なんですが、これでチェック漏れがなくなりそうです。

本当に、本当にありがとうございました。
(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.