エクセルVBAでコメントのコピー

質問

こんにちは。現在VBAでデータ集計をしている者です。
作業内容に沿った説明をしていると長くなりそうなので単刀直入に伺います。

たとえば、A列のいくつかの行のセルにコメントが挿入されていたとします。
そのコメントをコピーして、ひとつ隣のB列のセルにコメント"内容"をペーストしたいと考えているのですが、うまくいきません。
何か良い方法はないでしょうか。

その逆(B列のセルのデータをその隣のA列にコメントとしてコピー)なら以下のソースでできるのですが…。

Sub Comment_Copy()
Dim C_str As String
Dim i As Integer

For i = 1 To 100
If ActiveSheet.Cells(i, 2).Value <> "" Then
C_str = ActiveSheet.Cells(i, 2).Value
ActiveSheet.Cells(i, 1).AddComment (C_str)
End If
Next i

End Sub

回答No.4

imogasi · ベストアンサー

Sub Comment_Copy()
Dim i As Integer
For i = 1 To 10
If Not Cells(i, "A").Comment Is Nothing Then
ActiveSheet.Cells(i, "B").AddComment Cells(i, "A").Comment.Text
ActiveSheet.Cells(i, "B") = Cells(i, "A").Comment.Text
End If
Next i
End Sub
以下はテスト中にコメントの抹消用に使ってください。
Sub test02()
For i = 1 To 10
If Not Cells(i, "B").Comment Is Nothing Then
ActiveSheet.Cells(i, "B").Comment.Delete
End If
Next i
End Sub
コメントテキストだけ問題にしてます。
Ａ列からＢ列です。

お礼

どうもありがとうございます。
For Next 文だと理解しやすいですね。（自分だけだと思いますが…

ActiveSheet.Cells(i, "B").AddComment Cells(i, "A").Comment.Text
の分を消せば、test02のプロシージャはなくてもよさそうです。単純にコメントの文章だけを取り出せば良いので。

おかげ様で無事解決いたしました。
答えてくださった方々に感謝します。ありがとうございました。
ポイントは自分の理解度によって付けさせていただきます。

回答No.3

Wendy02

こんばんは。
こうすれば良いと思います。

A列指定なら、

Sub CommentFind()
Dim c As Object
For Each c In ActiveSheet.Comments
　 If c.Parent.Column = 1 Then
　　 c.Parent.Offset(, 1).Value = c.Shape.DrawingObject.Text
　 End If
Next c
End Sub

列を指定しないのでしたら、
Sub CommentFind()
Dim c As Object
For Each c In ActiveSheet.Comments
　　c.Parent.Offset(, 1).Value = c.Shape.DrawingObject.Text
Next c
End Sub

お礼

列指定の有無で答えてくださってありがとうございます。

回答No.2

taocat

No1です。

申し訳ありませぬ。
わざわざ難しくしておりました。
以下でお願いします。

---------------------------------------------
Sub Test()

　Dim myCell As Range

　On Error Resume Next

　For Each myCell In Range("A:A")

　　myCell.Offset(, 1).Value = myCell.Comment.Text

　Next myCell

End Sub
------------------------------------------

以上です。

お礼

度々どうもありがとうございました。

回答No.1

taocat

こんにちは。

色々方法はあると思いますが、こんなんでもできるよということで。

------------------------------------------------
Sub Test()

　Dim myCell As Range

　On Error Resume Next

　　For Each myCell In Range("A:A")

　　　myCell.Comment.Parent.Offset(, 1).Value = myCell.Comment.Text

　　Next myCell

End Sub
----------------------------------------------

以上です。

お礼

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