• 締切済み

エクセルでセルの入力履歴をコメントで表示させる

お世話になります　エクセルを勉強しているものです。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count <> 1 Then Exit Sub If Target.Value = "" Then Exit Sub If Intersect(Target, Range("A1:A10")) Is Nothing Then Exit Sub myTime = "入力月日・時刻" & Chr(10) & Month(Date) & "月" & Day(Date) & "日" myTime = myTime & Chr(10) & Hour(Time) & ":" & Second(Time) Target.AddComment myTime End Sub を使うとコメント表示になるとあったので挑戦していますが 入力時は問題ないですが、そのセルの入力を削除してまた入力するとエラーになります。 これを回避する方法はありますか？　

みんなの回答

  • mitarashi
  • ベストアンサー率59% (574/965)
回答No.3

おもしろそうなので、自分でも使ってやろうかといじっていたら長くなってしまいました。 xl2010で試していますが、コメントの文字数は280文字が限界の様なので（試行結果からで調べてはおりません）、最近の5件だけを保持する様にしています。時間の記録をFormatでもっと短くしたり、入力された値も記録していますので、入力される文字数が短い場合には、行数は増えせます。 ご参考まで。 Private Sub Worksheet_Change(ByVal Target As Range) Dim myComment As String, currentComment As String Dim lineCount As Long, firstLFpos As Long If Target.Count <> 1 Then Exit Sub If Intersect(Target, Range("A1:A10")) Is Nothing Then Exit Sub If TypeName(Target.Comment) = "Nothing" Then myComment = CStr(Now()) & " : " & Target.Value Target.AddComment myComment lineCount = 1 Else currentComment = Target.NoteText lineCount = Len(currentComment) - Len(Replace(currentComment, Chr(10), "")) + 1 '5行に制限　コメントの上限は280文字らしい If lineCount >= 5 Then firstLFpos = InStr(1, currentComment, Chr(10)) currentComment = Mid(currentComment, firstLFpos + 1, Len(currentComment) - firstLFpos) Else lineCount = lineCount + 1 End If myComment = currentComment & Chr(10) & CStr(Now()) & " : " & Target.Value Target.Comment.Text myComment End If With Target.Comment.Shape .Width = 200 .Height = lineCount * 12 End With End Sub

画像を拡大する
  • KURUMITO
  • ベストアンサー率42% (1835/4283)
回答No.2

次のようにTarget.ClearCommentsを追加入力すればよいでしょう。 Target.ClearComments myTime = "入力月日・時刻" & Chr(10) & Month(Date) & "月" & Day(Date) & "日" myTime = myTime & Chr(10) & Hour(Time) & ":" & Second(Time) Target.AddComment myTime

  • mu2011
  • ベストアンサー率38% (1910/4994)
回答No.1

コメント追加の直前でコメント有無を判定、有ればコメント削除で如何でしょうか。 If Target.NoteText <> "" Then Target.ClearComments

  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. その他MS Office製品

関連するQ&A

  • ExcelVBA 二つのセルに入力された時の判定

    セルA1とA2両方に値が入力された時、セルA3に文字を入力するマクロを作りたいです。 下記プログラムで試しているのですが、ステップインで見ると最初のIFでTrue判定されてしまいます。 どうすればこの条件を満たすマクロになるのか、教えて頂けないでしょうか。 以上、宜しくお願い致します。 Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("A1")) Is Nothing Or Intersect(Target, Range("A2")) Is Nothing Then Exit Sub Else If Range("A1").Value <> "" And Range("A2").Value <> "" Then Range("A3").Value = "入力済み" End If End If End Sub

  • エクセルのマクロ

    セルの値が変わったら動くマクロですが、2つ書くとエラーが出ます。 どのように直したらいいでしょうか？ Private Sub Worksheet_Change(ByVal Target As Range) Select Case Target.Address If Intersect(Target, Range("EK22")) Is Nothing Then Exit Sub Else Range("EK24:EM28").Select Selection.ClearContents End If End Sub Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("EK24")) Is Nothing Then Exit Sub Else Range("EK27:EM28").Select Selection.ClearContents End If End Sub

  • エクセルVBAのイベントについて教えてください。

    エクセルVBA初学者のです。 "C9"にいれるとchangeイベントが発生するコードなんですが、 "C9"のほかに"D1"においてもchangeイベントを発生させたいのですが 下記のコードに続けて書いてもイベントが発生しないのですが どのように書けばよいのでしょうか？ private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("C9")) Is Nothing Then Exit Sub Range("H14:H56").Interior.ColorIndex = 2 If Intersect(Target, Range("D1")) Is Nothing Then Exit Sub Range("G14:G56").Interior.ColorIndex = 2 End Sub よろしくお願いします。

  • エクセルVBAでTargetのセルに設定された「名前の定義」の取得方法は？

    例えば、A1、B2、C3セルに「名前の定義」で、それぞれ入力A、入力B、入力C　という名前がつけてあります。 それらのセルに入力があった場合、Select Caseで分岐させ作動するマクロをつくりました。 簡略化すると以下のようなもので、一応正しく作動します。 Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("入力A,入力B,入力C")) Is Nothing Then Exit Sub Select Case Target.Address(0, 0) Case "A1" MsgBox "A処理します。" Case "B2" MsgBox "B処理します。" Case "C3" MsgBox "C処理します。" End Select End Sub ただ、せっかくセルに名前を定義してあるのに、個々の入力セルの判定をTarget.Addressでしているのが不満です。 (￣～￣;) 定義された名前を使えないかと以下のようにやってみましたが実行時エラーで「サポートしてません」となってしまいます。 (T.T) Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("入力A,入力B,入力C")) Is Nothing Then Exit Sub Select Case Target.Names.Name 'ここでエラー Case "入力A" MsgBox "A処理します。" Case "入力B" MsgBox "B処理します。" Case "入力C" MsgBox "C処理します。" End Select End Sub どうやったら、Targetに設定されている名前を取得できるのでしょうか？ (^∇^`)？ 実際の例はもっと対象が多いので、Select Caseを使わない以下の方法は避けたいのです。 If文の羅列（これでも正しく作動はします。） Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("入力A,入力B,入力C")) Is Nothing Then Exit Sub If Not Intersect(Target, Range("入力A")) Is Nothing Then MsgBox "A処理します。" ElseIf Not Intersect(Target, Range("入力B")) Is Nothing Then MsgBox "B処理します。" Else MsgBox "C処理します。" End If End Sub なにとぞよろしくお願いします。　(o。_。)oペコッ

  • エクセルマクロで値入力時に時間が自動入力できる

    あるセルに値が入力されたら、 他の場所にその時間が入力されるような エクセルマクロを作りたいと考えています。 インターネットで調べて 下記の様にして1ヵ所だけは入力できるようになりました。 '時間の自動入力 Private Sub Worksheet_Change(ByVal Target As Range) 'Dim k As Long 'i = 9 If Intersect(Target, Range("C8")) Is Nothing Then Exit Sub Else d2 = Time Range("G8").Value = d2 End If End Sub 上記のマクロだと C8固定になってしまうので、 C8～C100で　上から順番に入力したときに それぞれの入力時に動作するように 変更したいと考えています。 そこで変数を設定し、ifで1つづつ変数を増やす処理を入れる前に 実験的に以下の様に書き換えてみたのですが、 Dim i As Long i = 9 If Intersect(Target, Cells(9, 3)) Is Nothing Then 動作しませんでした。 インターネット上に載せてくれている方の情報では range用　みたいなことを書いてあるのを見たのですが、 やはりこの方法ではうまくいかないでしょうか？ よろしくお願いします。

  • エクセルマクロvbのchangeイベントで複数入力した時フリーズして困っています

    マクロ初心者で困っています。 セルに『新規』と入力すると、Ｔ２セルに『Ｆ』と表示されるようにしたのですが、 『新規』をコピーして複数セルに貼り付けると貼り付けた状態のままパソコンが動かなくなってしまいます。 複数のセルがchangeした場合、マクロを終了する方法はないでしょうか？ 教えて下さいm(_ _)m Private Sub Worksheet_Change(ByVal Target As Range) Dim tr As Integer Dim x As String If Intersect(Target, Range("H4:H253")) Is Nothing Then Exit Sub x = Target.Value tr = Target.Row If x = "" Then Exit Sub If x = "新規" Then Range("T2") = "F" 　 End sub

  • エクセルにてダブルクッリクしたときの動作

    エクセルにて特定のセルをダブルクリックをした時に日付を表示させたくて以下のマクロを組みました。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range,Cancel As Boolean) If intersect(Target, Range("A1")) Is Nothing Then Exit Sub If ActiveCell = "" Then ActiveCell = Format(date, "yyyy") Cancel = True End If End Sub この場合A1セルをダブルクリックした時のみ西暦が入力されるようになっていますが、他のセルで、例えばB1セルでは月、C1セルでは日にちをダブルクリックで入力させるにはどうしたら良いでしょうか？ If intersect(Target, Range("A1")) Is Nothing Then Exit Sub のTarget, Rangeを書き換えて複数このマクロを書き込んだのですがうまく動作しなくて。 知恵を貸していただけると助かります。

  • 入力した日付の表示

    このコーナーを閲覧して勉強をさせていただいています。 Ａ１に文字を入力すると、その日付を表示させるにはという質問に対して、次のような回答がありました。 早速利用させて貰おうかと思っているのですが、これで、任意の場所（Ｈ１）に表示させるにはどうしたらいいのでしょうか。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$A$1" Then Exit Sub Target.Offset(1).Value = Date End Sub 横から口を出すような格好になってすみません。

  • VBA Intersectで範囲の記述

    エクセル2000です。 Intersectで範囲の記述で、名前が定義された範囲、myRng と　その2列右どなりを指定したいのですが、 Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Union(Range("myRng"), Range("myRng").Offset(, 2))) Is Nothing Then Exit Sub MsgBox Target.Address End Sub のようにUnionを使わなければできないでしょうか？ myRngがA1:A10であれば、 If Intersect(Target, Range("A1:A10,C1:C10")) Is Nothing Then Exit Sub と簡単に記述できるのですが。

  • Excelのworksheetどこ間違えてますか？

    Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("A1:A65536")) Is Nothing Then Exit Sub If 0 < Target.Value And Target.Value < 6 Then Target.Offset(0, 1).Value = Format(Time, "h時m分s秒") Else Target.Offset(0, 1).Value = "" End If End Sub 以前、このサイトで教えてもらったワークシートのプログラムです。 簡単に言えばＡ列に１から５までの値を入れれば現在時間をＢ列に 表示し、それ以外の場合は何もいれないと言ったものです。 以前はできたんですが最近また入れるとできなくなっていました。 どこかおかしいとこありますでしょうか？？

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する