エクセルのコメントの重複削除するマクロ

質問

こん＊＊は、

エクセルでデータの入ったセルにコメントが書かれています。コメントの中にはまったく同じ内容のものがいくつかあるのですが、重複しているものを除いて、書き出すことは可能でしょうか？

セルの値で重複しているものを削除する方法は、他の書き込みを見てわかったのですが、コメントの場合はどうしたらいいでしょうか？コメントをすべてどこかのセルにいったん書き出して、そこから重複したものを削除するしか方法はないでしょうか？

何かいい方法があれば、ご教示下さい。よろしくお願いします。

回答No.4

Wendy02 · ベストアンサー

こんばんは。

列ごとに、コメントの重複を削除します。
また、これは、コメント内の末尾に改行コードが、万が一入っても、文字の比較で削除されます。（#1のお礼を読んだ後なので、付け加えました。）

使い方は、カーソルを、削除したい列のセルに置いてから実行します。

-----------------------------------------------
'標準モジュール

Sub TestMacro()
Dim rng As Range
Dim ar() As String
Dim ret As Variant
Dim buf As String
Dim i As Long
Set rng = Intersect(ActiveSheet.UsedRange.Columns(1), Selection.EntireColumn)
If rng Is Nothing Then
　 MsgBox "検索する列のセルをひとつ選んでください!", vbInformation
　 Exit Sub
End If
ReDim ar(rng.Cells.Count - 1)
For i = 1 To rng.Cells.Count
　　If Not rng.Cells(i).Comment Is Nothing Then
　　　buf = WorksheetFunction.Clean(Trim(rng.Cells(i).Comment.Text))
　　　On Error Resume Next
　　　ret = 0
　　　ret = WorksheetFunction.Match(buf, ar(), 0)
　　　On Error GoTo 0
　　　If ret > 0 Then
　　　　 rng.Cells(i).Comment.Delete
　　　Else
　　　　 ar(i - 1) = buf
　　　End If
　　　buf = ""
　　End If
Next i
Set rng = Nothing
End Sub

なお、やってみると、このマクロでは、空のコメントは、削除されるようです。

お礼

忙しい中、回答ありがとうございました。

思っていた通りのことができました！私の使用に合うように、少し修正させて使わせていただきます。本当に助かりました。m(__)m

回答No.3

imogasi

まさか関数でできると考えてないでしょうね。関数ではできません。セルの属性である「値」と、同じくセルの属性であるコメントは別世界の情報だからです。
ですからVBAでやらなければ、手作業しかない。
ーー
A1:E6のコメントの、重複状況をH列に出すプログラムを作ってみました。しかし＃１のお礼から、質問者のケースに合わせて修正できないのかなと思いますので、無駄でしょうが、載せておきます。
この課題は高望みしすぎではないかと思います。
Sub test01()
Dim c(100)
k = 1
c(1) = ""
Dim cl As Range
Range("A1:E6").Select
Selection.SpecialCells(xlCellTypeComments).Select
'--
For Each cl In Selection
MsgBox cl.Comment.Text & cl.Address
'--
For i = 1 To k
If c(i) = cl.Comment.Text Then
Cells(k, "H") = cl.Address & "重複" & cl.Comment.Text
End If
Next i
c(k) = cl.Comment.Text
k = k + 1
'--
Next
End Sub
Msgboxの表示がしつこいときは、削除すればよい。

お礼

回答ありがとうございました。

関数でできるとは思っていません。質問のタイトルにも書いたようにマクロで処理しようと考えています。コメントの入っているセルの個数がとても多いので、今後のこともあるので、手作業は考えておりません。

ご教示いただいたサンプルをもとに、少し試行錯誤してみようと思います。ありがとうございました。

最初の質問の中で、説明不足があり、回答していただいた方にご迷惑をかけ、申し訳ありません。

回答No.2

zap35

重複しているコメントを削除するマクロです。
以下のマクロをALT＋F11でVBE画面を開き、左上のVBA Projectでシート名を右クリックし「挿入」→「標準モジュール」で表示される画面に貼り付けて下さい。マクロの実行はワークシート画面に戻ってALT＋F8でマクロ一覧を開き、マクロ名を選択して「実行」ボタンです。

Sub Macro1()
Dim myDic As Object
Dim idx, cnt As Long
Dim wkNo()
With ActiveSheet
　　If .Comments.Count > 1 Then
　　　　ReDim wkNo(.Comments.Count)
　　　　Set myDic = CreateObject("Scripting.Dictionary")
　　　　For idx = 1 To .Comments.Count
　　　　　　If Len(.Comments(idx).Text) > 0 Then
　　　　　　　　If myDic.exists(.Comments(idx).Text) Then
　　　　　　　　　　cnt = cnt + 1
　　　　　　　　　　wkNo(cnt) = idx
　　　　　　　　Else
　　　　　　　　　　myDic.Add .Comments(idx).Text, ""
　　　　　　　　End If
　　　　　　End If
　　　　Next idx
　　　　For idx = cnt To 1 Step -1
　　　　　　.Comments(wkNo(idx)).Parent.ClearComments
　　　　Next idx
　　　　Set myDic = Nothing
　　End If
End With
End Sub

マクロはテストしていますが、元のブックをセーブしてから試してください。

お礼

忙しい中、回答ありがとうございました。

＃１の方へのお礼でも述べたのですが、列ごとに重複するコメントを削除したいと考えています。私の質問の不備のためにご迷惑をかけてすみませんでした。ご教示いただいたマクロを参考に考えてみたいと思います。

回答No.1

n-jun

アクティブシートのコメントで、重複したものは１つとして
イミディエイトウインドウに書き出します。

Sub　Test()
　Dim　Dic　As　Object
　Dim　c　As　Object
　Dim　key
　Set　Dic　=　CreateObject("Scripting.Dictionary")
　For　Each　c　In　ActiveSheet.Comments
　　　　　If　Not　Dic.Exists(c.Text)　Then
　　　　　　　　Dic(c.Text)　=　Empty
　　　　　End　If
　Next

　For　Each　key　In　Dic.keys
　　　　　Debug.Print　key
　Next
End　Sub

ご参考になれば。

お礼

早速の回答ありがとうございます。

少し質問が舌足らずでした。例えばＡ列～Ｃ列の１行目～100行目までに入っているコメントを、列ごとに重複したものを除外したいのです。例えばＡ列とＢ列に同じコメントが入っていても、それは残しておきたいのです。

For　Each　c　In　ActiveSheet.Commentsの部分を修正すればできそうなのですが、よくわかりません。もしよろしければご教示いただければ助かります。

よろしくお願いいたします。