『(VBA・マクロ)リーダーで読み取った日付の入力と、日付ごとの総数を求めたいです。』（さかな） 会員番号をバーコードリーダーで読みとり、 読み取った日付をもとに、その日の入館者数と今までの入館者数を Excel上で表示させたいと考えております。 (※なお、バーコードリーダーに日付を読み取る機能がないため、 NOW関数で情報を入力しております。) NOW関数ではじき出された情報をもとに、COUNTIF関数で その日付の総数を出したいのですが、うまく表示させることができません。 マクロを組んで、「バーコードで情報を読み取った際、NOW関数で 日付を入力し、入力した情報から、日付ごとの総数を表す」みたいな ことはできないでしょうか。。 今のところ、「バーコードで情報を読み取った際、NOW関数で 日付を入力する」部分までは、関数などで実現ができております。 どなたかご存じの方がいらっしゃいましたら、此の実現の 方法についてお教えいただけますと幸いです。 ーーーーーーーーーーーーーーーーーー 【やりたいことのイメージ】 バーコードリーダーで情報を読み取る際、 NOW関数でC列に読み取った日付を表示。 Bの列に日付(値)のみを参照し、G列の「本日の入館者数」の部分に 日付ごとの総数を出したい。 なお、その日の日付は、A1のセルにて参照。 A　　　 　B　　　C　　　　G　　　 1 TODAY関数 2 ID　 日付　NOW関数　　本日の入館者数(=COUNTIF(B$3:B$1048576,A1))　　　　　　　 3　　　　　　　　　　　　 　2　　 4 001　　5/24　=IF(A$3:A$1048576="","",NOW()) 5 002　　5/25　 6 003 　 5/26　　　　　　 総数(=COUNTA(A$3:A$1048576)) 7 004 　 5/26 　　　　 　　 4 .　　 . . 以上になります。 分かりづらくて申し訳ないのですが、ご回答、よろしくお願いいたします。 ＜ 使用 Excel：Excel2016、使用 OS：Windows10 ＞ ---- こんにちわ　＾＾ A4以降にバーコードリーダーから自動入力されるのでしたら 当該のシートモジュールの Private Sub Worksheet_Change(ByVal Target As Range) End Sub ↑　を使って、値が変われば、その隣にNOWを入れておけば シリアル値なので、後でどのようにでも加工可能ですよ。 合計は、別枠でループ回すなり、ワークシート関数なりで。 エラー処理はしないと、思いもよらない大惨事になることも＾＾； べつに、リーダーと連動する必要が無ければ、取込後、マクロ処理 でも　←　こちらの方が無難かと思われます でわ m(__)m （隠居Z） 2022/05/26(木) 16:05 ---- 隠居Zさま 早速ご回答をいただき、ありがとうございました。 せっかく回答をいただいたのにも関わらず、 どのようにマクロに入力したらよいのかがわからず。。 大変申し訳ないのですが、お教えいただいてもよろしいでしょうか>< （さかな） 2022/05/26(木) 16:39 ---- 今、マクロの記録を使い、バーコードで読み取った日時をC列のNOW関数にて表現し、 B列の日付にコピペするマクロを作成しました。 この後、異なるバーコード情報を読み取った際に、 A4以降のセルにて同じ動作を行いたいと考えております。 どのように書けばよいのでしょうか。。泣 ーーーーーーーーーーーーーーーー 'Private Sub Worksheet_Change(ByVal Target As Range) ' ActiveCell.FormulaR1C1 = "1" Range("C4").Select Selection.Copy Range("B4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False End Sub （さかな） 2022/05/26(木) 16:48 ---- こんばんわ　＾＾ 当方はバーコードリーダもインターフェースも有りませんので テストは行えませんが、多分、チェンジイベントは拾ってくれるかと。＾＾； 当該のシートモジュールに　 Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Target.CountLarge > 1 Then Exit Sub If Intersect(Target, Me.Range("A4:A1048576")) Is Nothing Then Exit Sub Application.EnableEvents = False Target.Offset(, 1) = Now Application.Run "Module1.ddws01mk" Application.EnableEvents = True End Sub 標準モジュール[Module1]に←重要＾＾ シート名は　Sheet1 で設定 シート名が実際の物と違う場合は、ご変更お願いいたします。 Option Explicit Private Sub ddws01mk() Dim i As Long Dim cNt As Long Application.EnableEvents = False With Worksheets("Sheet1") .Range("g3,g7").Clear For i = 4 To .Cells(.Rows.Count, 2).End(xlUp).Row If Int(.Cells(i, 2).Value2) = .Cells(1, 1).Value2 Then cNt = cNt + 1 End If Next .Range("g3") = cNt .Range("g7").Formula = "=COUNTA(A$4:A$1048576)" End With Application.EnableEvents = True End Sub　 エラー処理、便利機能は、ありませんが、大事には、ならないかと。。。←多分＾＾； m(_ _)m （隠居Z） 2022/05/26(木) 17:24 ---- 追伸　A1　には当日の日付が入力済み 各、項目名も入力済、が、前程です。 最初から、バーコード情報と日付以外は、書き直し していたのですが、ややこしいと思いましたので、 外しています。ｇ3とｇ7、セルは初期化されます バックアップ、必須で。。。A^^;。。。m(__)m （隠居Z） 2022/05/26(木) 17:32 ---- すみません B列に書き込みしています。もし nowの書込み先がC列なら、試さないでください、 B列の日付が消失します。 （隠居Z） 2022/05/26(木) 17:37 ---- 何回も相済みません。ｗ どこかの、アップデート。。。みたい　(￣▽￣) Ａ列の値が、空白に変わった場合でも、NOWは入力されます。 しないようにも出来ますが、あり得ない事なら、良いのですが 計算の根拠に使っていると思いますので、ソースコードを よく、ご理解の上で、適宜、変更してくださいね。 テストして、不具合があれば、生きていましたら、対応させて 戴きます。＾＾； でわ、でわ。。。m(_ _)m （隠居Z） 2022/05/26(木) 17:49 ---- ご返信が遅れました…！ とっても丁寧に記入をいただき、ありがとうございました（泣 明日、いただいた内容で試してみたいと思います…！ 本当にありがとうございましたm(__)m （さかな） 2022/05/26(木) 18:07 ---- ご連絡が遅くなりました。 無事、いただいたマクロの内容で動作の確認が行えました。 いただいたコードを基に自分で応用が効けるよう、勉強してみたいと思います。 取り急ぎ、お礼のご連絡でした。 ご対応をいただきまして本当にありがとうございました;; （sakana） 2022/05/27(金) 14:54 ---- g7に計算式があるならば、下記の様な事でも また Changeイベントとは切り離して、ピッピ、がおわってから ddws01mk()を実行でも、負担が少なくていいかもしれません。 なにかの、参考にでもなれば、幸甚です。m(__)m Option Explicit Private Sub ddws01mk() Dim i As Long Dim cNt As Long Application.EnableEvents = False With Worksheets("Sheet1") Rem .Range("g3,g7").Clear .Range("g3").Clear For i = 4 To .Cells(.Rows.Count, 2).End(xlUp).Row Rem If Int(.Cells(i, 2).Value2) = .Cells(1, 1).Value2 Then If Int(.Cells(i, 2).Value2) = .Cells(1, 1).Value2 And .Cells(i, 1) <> "" Then cNt = cNt + 1 End If Next .Range("g3") = cNt Rem If .Range("g7").HasFormula = False Then Rem .Range("g7").Formula = "=COUNTA(A$4:A$1048576)" Rem End If End With Application.EnableEvents = True End Sub （隠居Z） 2022/05/27(金) 16:14 ---- 隠居Z　さま 丁寧にコードをアップデートくださり本当にありがとうございます。。！ 前回いただいたコードと、どちらのほうが運用に適しているか、実際に動かして比べてみたいと思います。 実は、質問させていただいた内容とは別の問題が起きておりまして。。 いただいたお返事に質問で返してしまい、大変恐縮なのですが、 以下内容についてご存じであればお教えいただきたいと思います。 【発生している問題】 今回使用するバーコードリーダーに日付入力の機能がないため、 バーコード読み取りのタイミングでNOW関数が働くよう、Excel上に設定しております。 この関数を使用しているせいか、表が日付ごとの表示にならず、 過去に読み取った日時を含め、すべての表の内容が本日中の日付として表示されるようになってしまいます。 説明が分かりづらくて申し訳ないのですが、下図のようになってしまうイメージです。 A　　　 　B　　　C　　　　G　　　 1 5/30(=TODAY) 2 ID　 日付　NOW関数　　本日の入館者数(=COUNTIF(B$3:B$1048576,A1))　　　　　　　 3　　　　　　　　　　　　 　4　　 4 001　　5/30　=IF(A$3:A$1048576="","",NOW()) 5 002　　5/30　 6 003 　 5/30　　　　　　 総数(=COUNTA(A$3:A$1048576)) 7 004 　 5/30 　　　　 　　 4 .　　 . . 理想は以下のように、過去に読み取った日付は変更されないようにしたいのですが、 良い方法をご存知でしょうか、、、？ A　　　 　B　　　C　　　　G　　　 1 TODAY関数 2 ID　 日付　NOW関数　　本日の入館者数(=COUNTIF(B$3:B$1048576,A1))　　　　　　　 3　　　　　　　　　　　　 　2　　 4 001　　5/24　=IF(A$3:A$1048576="","",NOW()) 5 002　　5/25　 6 003 　 5/30　　　　　　 総数(=COUNTA(A$3:A$1048576)) 7 004 　 5/30 　　　　 　　 4 .　　 . . （さかな） 2022/05/30(月) 12:59 ---- こんにちわ　＾＾ え〜と 単に数式の事だけでしたら。当日が、翌日に変わる前に ピッピした部分の数式をコピペの値貼付けで値に変換して、 保存しておけば良いのではないでしょうか。 先日ご案内させて戴きましたマクロですと、B,C列の表示位置の差はありますが 数式ではありませんので、[現在の合計用のもの以外は数式は必要御座いません。]そのままで も、お使いになれると思いますが。 私の勘違いでしたら。お許しを。。。(#^ ^#) マクロは一度実行すると元には戻せません[コントロール+Zが使えません＾＾；] バックアップは必須要件なので、御気を付け下さいませ。 でわ m(__)m （隠居Z） 2022/05/30(月) 14:00 ---- 追伸 Ａ列の最終行まで使用してしまい さらに、そのまま、ピッ！すれば。。。どぉなるか 私には分かりません。[キーボード入力は自動でとまるみたいですが。]というか エクセルも10万行を超えると、使用列数にもよりますが 段々重くなると思いますので。てきと〜に マクロなら、エラー処理を追加するか、その手前で 何らかの処理で【シートの初期化、ブックの切替などなど、いろいろ　＾＾ｖ】 またＡ４から入力出来るよ~にしてくださいね。m(__)m 余計なお世話でしたら、無視して下さい。＾＾； m(__)m （隠居Z） 2022/05/30(月) 14:27 ---- 初心者の私に色々とご教示いただき、ありがとうございます。 なるほど、値のみ貼り付ける操作については自動化では難しそうですね。。 こちらは日付が更新される前に、手動で作業をしたいと思います。 また、留意点についてご案内をいただきありがとうございます。 自分でも勉強をし、理想の形に更新していきたいと思います！ また、14：27に投稿いただいた留意点についてもご案内をいただきありがとうございます。。 Excelシートの更新期限なども検討項目として入れさせていただきます。 ここまで丁寧な対応をいただき本当にありがとうございました。。！ （さかな） 2022/05/30(月) 14:41