VBAセルへの他セルのコピペコメント挿入マクロ

このQ&Aのポイント
  • VBAを使用して、A1~A200のセルにD1~D200の値をコピーしたコメントを挿入するマクロを作成したいです。
  • コメントには、D1をA1に、D2をA2になど、対応するセルの値を貼り付けたいです。
  • Private Sub Worksheet_Changeという記述になると思いますが、上手く動作しません。解決策を教えてください。
回答を見る
  • ベストアンサー

VBA セルに他セルをコピペしたコメントを挿入 

A1~A200のセルに、D1~D200の値をそれぞれコピーしたコメントを挿入するマクロを作ろうとしています。 A1に、何も書いていないコメントを挿入することはできました。 Dim i As Long For i = 1 To 200 Range("A" & i).AddComment Range("A" & i).Comment.Visible = False Next i End Sub このコメントに、D1~D200の値を貼り付けたい場合は(A1にはD1の値を、A2にはD2の値といった具合)どのように書けばよいのでしょうか? Private Sub Worksheet_Change という記述になるのかと思いますが、うまくいかないのでどなたかご存じでしたら教えてください。 よろしくお願いします。

質問者が選んだベストアンサー

  • ベストアンサー
  • dell_OK
  • ベストアンサー率13% (741/5648)
回答No.3

その3。 「Worksheet_Change」だと関係のないセルを変更した時もなんだかチラチラと動作して操作性が落ちるので、 もし任意のタイミングで実行するのでよければ。 Public Sub SetComment() Dim i As Long For i = 1 To 200 If Range("A" & i).Comment Is Nothing Then Range("A" & i).AddComment Range("D" & i).Text Else Range("A" & i).Comment.Text Range("D" & i).Text End If Next i End Sub

potetito
質問者

お礼

ご回答ありがとうございます! 出来ました!まるごとコピペで出来ました! Public Sub SetComment() Dim i As Long For i = 1 To 200 If Range("A" & i).Comment Is Nothing Then Range("A" & i).AddComment Range("D" & i).Text Else Range("A" & i).Comment.Text Range("D" & i).Text End If Next i End Sub ありがとうございます! これで明日から残業が減りますよ~!(^O^)/

その他の回答 (2)

  • kkkkkm
  • ベストアンサー率65% (1623/2463)
回答No.2

A1だけで考えると Range("A1").AddComment Range("A1").Comment.Text Text:=Range("D1").Value あとは挿入したいタイミングでRange("A" & i)やRange("D" & i)などとして対応してください。

potetito
質問者

お礼

ご回答ありがとうございます。 下記で試してみたところ、なぜかA1のコメントにD11の値が貼り付き、且つA10以降はコメントが空白になっていました。 Sub Macro1_1() Dim i As Long For i = 1 To 200 Range("A" & i).AddComment Range("A" & i).Comment.Text Text:=Range("D1" & i).Value Range("A" & i).Comment.Visible = False Next i End Sub 何か間違っていますか。。? 勉強不足ですみません。

  • dell_OK
  • ベストアンサー率13% (741/5648)
回答No.1

どのような方法でうまくいかないかがわからないので、「Worksheet_Change」をヒントに回答します。 その1。 D列(4列目)の1行目から200行目が変更される度にその行のA列のコメントを変更する。 先に空のコメントを準備されているようなのでこれでできると思います。 If Target.Column = 4 And Target.Row >= 1 And Target.Row <= 200 Then Cells(Target.Row, 1).Comment.Text Target.Text End If その2。 どのタイミングで空のコメントを準備しているのかわかりませんが、 開く時だと毎回になってしまうし、 手作業で一度だけ実行しているのならそれも手間かと思って、 先に空のコメントを準備しない方法。 コメントがなければ追加、あれば変更しています。 If Target.Column = 4 And Target.Row >= 1 And Target.Row <= 200 Then If Cells(Target.Row, 1).Comment Is Nothing Then Cells(Target.Row, 1).AddComment Target.Text Else Cells(Target.Row, 1).Comment.Text Target.Text End If End If

potetito
質問者

お礼

ご回答ありがとうございます! その1とその2は元々あった文章にそのまま繋げてみたところエラーになってしまったのですが、その3で頂いたご回答で見事解決いたしました! ありがとうございます!!!

関連するQ&A

  • エクセル マクロ 選択した複数シートにコメント挿入のやり方

    はじめて質問させていただきます。 エクセルのマクロで選択された複数シートに順番に コメントを挿入する・・というのをしたいのですが うまくいきません。 "Exs.Range("A1").AddComment"の部分で 「実行時エラー:1004 アプリケーション定義またはオブジェクト定義のエラーです」 となってしまいます。 マクロの記録で試そうとも思ったのですが、 複数シートを選択すると、右クリックしても コメント挿入のメニューが表示されませんでした。 元々、複数シートへのコメント挿入はできないのでしょうか・・? ソースは以下です。 Sub Macro1() Dim Exs As Worksheet Dim sSheet As Long Dim i As Long '選択されたシート数を取得 sSheet = ActiveWindow.SelectedSheets.Count i = 1 '選択されたシート数分、A1セルにコメントをつけていく Do While i <= sSheet ActiveWindow.SelectedSheets.Item(i).Activate Set Exs = ActiveWorkbook.ActiveSheet Exs.Range("A1").ClearComments Exs.Range("A1").AddComment Exs.Range("A1").Comment.Visible = True Exs.Range("A1").Comment.Text Text:=Chr(10) & "てすとー" Exs.Range("A1").Select i = i + 1 Loop End Sub お解かりになる方いらっしゃいましたら、 なにとぞよろしくお願いいたします。

  • [VBA]セルのコメントの内容をセルに反映させたい

    VBAの勉強を始めたばかりの者です。 やりたいことは  (1)A1のセルにコメントを挿入する  (2)A1のコメントの内容をB2に読み込む (1)は Range("A1").Addcomment Text: = "あいうえお" としてみました。 (2)が分かりません・・・。 まず、読み込む=コピーという考え方で良いのでしょうか? A1をB2にコピーすることは出来たのですが、 コメントとなるとどうしたらいいのかすら分かりません。 どなたか教えてください! よろしくお願い致します。

  • エクセルマクロ(VBA)で指定したセルが変化したときに実行するには?

    VBAでsheetの中のworksheet_changeなどでマクロを書くと、そのシー トの中のどのセルを変化させてもマクロが実行されるのですが、これ を、A1とc1とc2が変化したときだけ処理を実行させたいのです。 以下のマクロのどこかを編集すると、そのようなことが出来るのでし ょうか? Private Sub Worksheet_SelectionChange(ByVal Target As Range) ----実行する内容---- End Sub Private Sub Worksheet_Change(ByVal Target As Range) ----実行する内容---- End Sub

  • エクセル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

  • マクロを使ってコメントを大量に挿入したい。Excel2002

    都市名が北から並んでいる表があり、各都市名にカーソルを合わせると各都市に応じたコメントが表示されるようにしたいです。表示させたいコメントの種類が5種類あり、塗りつぶし効果でコメントの背景に画像を表示させたりと、1つのコメントを作るのにちょっと手間がかかります。 少しでも手早くと思い、マクロの記録で手順を5パターン登録して、マクロの実行でコメントを表示させたいと考えております。でサンプルをひとつ作成し実行したのですがエラーになってしまいます。 (1)End with以降のselection.shaperange.fill~以降が駄目みたいで「オブジェクトはこのプロパティーまたはメソッドをサポートしていません」とエラーメッセージが表示されます。何がいけないのでしょうか? (2)G62のセルにコメントを挿入したいときのサンプルなんですが、G62だけじゃなくてどこのセルにでも対応できるようにしたいんですがどう書き直せば良いのでしょうか? 800字以内との規制があるみたいで関係ないと思われるエラー以降の部分を削除させて頂きました。何卒宜しくお願いいたします。 Sub Macro1() ' Macro1 Macro ' Range("G62").AddComment Range("G62").Comment.Visible = False Range("G62").Comment.Text Text:="" With Selection.Font .Name = "MS Pゴシック" .FontStyle = "太字" .Size = 9 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Selection.ShapeRange.Fill.Transparency = 0# Selection.ShapeRange.Line.Weight = 0.75 Selection.ShapeRange.Line.DashStyle =     中略  End Sub

  • VBAでセルごとにタイマーを使用できますか?

    VBA初心者のものです。が・・・ 'B4に値が入ったら30分後にB4の値をB5に移動する。 '対象セルはB4~AZ4までで、セルごとに30分後に値を一段下移動する。 とういうようなマクロを作りたいのですが、 タイマーはシート単位になるのでしょうか? 現在はダブルクリックイベントにてセルの値を下げています。 Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, Cancel As Boolean) Application.ScreenUpdating = False If Intersect(target, Range("b4:zz4")) Is Nothing Then Exit Sub Call 移動 End Sub Sub 移動() Dim c As Range Set c = ActiveCell ' 使用されている c.Select Selection.Cut c.Offset(1, 0).Select ActiveSheet.Paste End Sub 対象セルがたくさんあるので、なんとか自動処理できないものでしょうか?

  • VBA 検索して一致したセルへジャンプさせたい

    Excelにて、シート1のA列とシート2のA列のデータにNoを入れます。 シート1のA列のNoをクリックすると、シート2のA列の同じNoにジャンプするマクロを組みたいです。 現在組んでいるマクロは、 Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim Sht As Worksheet Dim Rng1 As Range Dim Rng2 As Range Dim FindCell As Range Set Sht = Worksheets("シート2") Set Rng1 = Range("A2:A100") Set Rng2 = Sht.Range("A2:A100")If Intersect(Target, Rng1) Is Nothing Then Exit Sub If Target.Count > 1 Then Exit Sub Set FindCell = Rng2.Find(Target.Value) If Not FindCell Is Nothing Then Application.Goto Reference:=FindCell, Scroll:=False End If End Sub です。 一応マクロは実行されますが、そうすると、シート1のA列の編集(Noを追加したり変更したり・・・)できません。 編集や変更もできて、検索マクロも実行できるというマクロの組み方はありますでしょうか?

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

    お世話になります エクセルを勉強しているものです。 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 を使うとコメント表示になるとあったので挑戦していますが 入力時は問題ないですが、そのセルの入力を削除してまた入力するとエラーになります。 これを回避する方法はありますか? 

  • 変化するセルが変更されたら実行、というVBAを組みたい

    たとえば、このセルが変更されたら実行、というのは Private Sub WorkSheet_change (Byval Target As Range) If(Target.Address = "$D$3") Then call *** End If End Sub のようにしますよね? この場合、指定したセルは「D3」ですが、たとえば、 A列、B列、C列、D列のアクティブの行のセルが変更されたらコード実行、 というようにするにはどうしたらいいのでしょうか?

  • Excel-VBA コメントの書式設定

    Excel-VBA コメントの書式設定 コメントの書式設定をExcel-VBAで定義したい。 従い「マクロの記録」を実行して下記のソースコードを取得しました。 これを実行すると次の実行エラーが発生しました!? ★正常に動作させるソースコードの事例をいただければ幸いです。 ご指導よろしくお願いいたします。 実行時エラー'438' オブジェクトは、このプロパティまたはメソッドをサポートしていません。 Sub Macro1() ' 処理:マクロの記録 ' 目的:「コメントの挿入」と「コメントの書式設定」をする。 Range("A2").Select Range("A2").AddComment Range("A2").Comment.Visible = False Range("A2").Comment.Text Text:="コメント" & Chr(10) & "今日は良いお天気ですね。" '▽次で実行エラーが起きる!? Selection.ShapeRange.ScaleWidth 1.58, msoFalse, msoScaleFromTopLeft Selection.ShapeRange.ScaleHeight 1.49, msoFalse, msoScaleFromTopLeft Selection.ShapeRange.Fill.Visible = msoTrue Selection.ShapeRange.Fill.Solid Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9 Selection.ShapeRange.Fill.Transparency = 0# Selection.ShapeRange.Line.Weight = 0.75 Selection.ShapeRange.Line.DashStyle = msoLineSolid Selection.ShapeRange.Line.Style = msoLineSingle Selection.ShapeRange.Line.Transparency = 0# Selection.ShapeRange.Line.Visible = msoTrue Selection.ShapeRange.Line.ForeColor.RGB = RGB(0, 0, 0) Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255) Selection.ShapeRange.LockAspectRatio = msoTrue Selection.ShapeRange.Height = 141.75 Selection.ShapeRange.Width = 283.5 Range("A1").Select End Sub