VBA ボタンに登録するセルの参照の仕方。

質問

参照するセルを指定する方法を教えていただきたいです。

現在の私の知識ですとボタン一つずつに参照セルを一つずつ手打ちするしかなくて。想定としては2000行に2000個ぐらいを想定しております。

フォームコントロールのボタンにマクロを登録して添付画像のように各行に一つづつ配置したいと考えております。

ボタンに登録するマクロは以下のようなもので、ボタンを配置した行と同じ列の特定セルを画像左側のカレンダーにペーストするといったものです。

Sub ボタン_Click()

' セルを選択してコピー
Range("AE2").Copy
ActiveCell.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False 'コピー状態が残るのでキャンセル

End Sub

皆様のお力を貸していただけると幸いです。
よろしくお願いします。

※エクセルのバージョンはHome and Business 2019 です。

回答No.15

kkkkkm

No.3のコードにカレンダー範囲外への代入を除外するのを追加したら

Sub ボタン1_Click()
If ActiveCell.Row < 2 Or ActiveCell.Column < Columns("D").Column Or ActiveCell.Column > Columns("J").Column Then
MsgBox "選択セルがカレンダー範囲外です", vbCritical
Exit Sub
End If
ActiveCell.Value = Cells(ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row, "AE").Value
End Sub

回答No.14

kkkkkm

回答No.13
は
回答No.3
と同じ事を回答してますが…見逃しかなぁ。

回答No.13

SI299792

要するに、
２行目のボタンを押す：AE2 →アクティブセルへコピペ。
３行目のボタンを押す：AE3 →アクティブセルへコピペ。
ですか。
画面にAE列はありませんが、そこにデータが入っている想定です。
Option Explicit
'
Sub Macro1()
　　Dim RowP As Long
'
　　RowP = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row
　　ActiveCell = Cells(RowP, "AE")
End Sub

回答No.12

kkkkkm

No.11の補足です

If Target.Column >= Columns("D").Column And Target.Column <= Columns("J").Column Then
Cancel = True
If MsgBox("カレンダーを更新しますか?", vbYesNo + vbQuestion) = vbYes Then
Target.Value = Cells(Range("X1").Value, "AE").Value
End If
End If

のところは念のために以下のようにしておいた方がいいかもしれません。

If Target.Column >= Columns("D").Column And Target.Column <= Columns("J").Column And Range("X1").Value <> "" And IsNumeric(Range("X1").Value) Then
Cancel = True
If MsgBox("カレンダーを更新しますか?", vbYesNo + vbQuestion) = vbYes Then
Target.Value = Cells(Range("X1").Value, "AE").Value
End If
End If

回答No.11

kkkkkm

No.3,No.4,No.5の追加です。

ボタンで操作が操作する人にとって感覚的に一番だと思いますが
ダブルクリックもありかもしれません。
X列でダブルクリックしてカレンダーでダブルクリックすると、AE列のデータが代入されるというものです。

たとえばX2をダブルクリックしてカレンダーの任意のセルをダブルクリックするとAE2のデータが代入される。
X1に行番号を入れますのでX1を開けておいてください。
(X1を見るとダブルクリックで該当行番号がセットされた事がわかります)

一度X列をダブルクリックするとカレンダーで何度でも同じAE列のデータを代入できます。

該当のシートモジュールに

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Row < 2 Then
Exit Sub
End If
If (Target.Column < Columns("D").Column Or Target.Column > Columns("J").Column) And Target.Column <> Columns("X").Column Then
Exit Sub
End If
If Target.Column = Columns("X").Column Then
Cancel = True
Range("X1").Value = Target.Row
Exit Sub
End If
If Target.Column >= Columns("D").Column And Target.Column <= Columns("J").Column Then
Cancel = True
If MsgBox("カレンダーを更新しますか?", vbYesNo + vbQuestion) = vbYes Then
Target.Value = Cells(Range("X1").Value, "AE").Value
End If
End If
End Sub

回答No.10

chie65535

訂正。
If Rw >2 And Rw < 2001 Then
は
If Rw >1 And Rw < 2001 Then
の誤りでした。

回答No.9

chie65535

ボタン１つで複数の行を処理する場合の例

Sub ボタン1_Click()
Dim Rg As Range
Dim Tg As Range
Dim Rw As Integer
Rw = 0
For Each Rg In Selection
If Rw <> Rg.Row Then
Rw = Rg.Row
Cells(Rw, 1).Interior.ColorIndex = 3
End If
Next
End Sub

このマクロは、選択している範囲の「A列」のセルの背景色を赤くします。

C5～M11を選択している状態でボタンを押すと、A5～A11のセルの背景が赤くなります。

RwにTg.Rowを代入した後に「Rwが２～２０００の範囲にある時だけ実行する」というif文を加えれば「表の外を選択している場合は無視する」ようになります。

Sub ボタン1_Click()
Dim Rg As Range
Dim Tg As Range
Dim Rw As Integer
Rw = 0
For Each Rg In Selection
If Rw <> Rg.Row Then
Rw = Rg.Row
If Rw >2 And Rw < 2001 Then
Cells(Rw, 1).Interior.ColorIndex = 3
End If
End If
Next
End Sub

このようにすれば「ボタン１つ」で「選択している範囲の複数の行」について処理できます。

２～２０００行を選択してボタンを押せば、２～２０００行の全部を予定作成出来ますし、転記も出来ます。２～２０００行の全部に2000個のボタンを置く必要はありません。

回答No.8

chie65535

ボタンは１個だけにして、ボタンは「スクロールしないように設定した見出し行」や「別シートのスクロールしない表」や「表と連動してスクロールしないユーザーフォーム」に置きます。

ボタンを押した時は「対象シートの、選択された行」に対して処理を行います。

３行目を処理させたい時は、A3やB3やC3などのセルを選択した状態で、ボタンを押します。

５～１２０３行をまとめて処理させたい場合は、A5～A1203のセルを選択した状態で、ボタンを押します。

こうする事で「１個のボタン」で「今、選んでいる行を自由に処理」できます。

画像の表にボタンを作るなら、

・A～K列の「左の表」は「2行目」から作成する
・L～V列の「右の表」は「1行目」から作成し、1行目を「見出し行」に設定してスクロールしないようにする
・ボタンを「X1セル」に置いて、スクロールしないようにする

という作り方をして、ボタンは「現在の選択範囲（但し、表の外側を選択範囲に含んでいる場合は無視する）ついて処理する」ようにマクロを作ります。

そうすると「１つのボタンで、自由に選んだ位置（行）について処理が可能」になります。

行ごとにボタンを量産する必要はありません。

それに、１つのブックにボタンを2000個も作ったら、マクロが巨大になり、ブックが開けなくなったり、ブックを開くのに時間が掛かったりして、実用にならないブックが出来上がります。

もし「ボタンを増やした直後に保存したら、ボタンが多過ぎるのが原因のラーで開き直す事が出来なくなった」としたら、2度とそのブックを開けなくなり、それまでの苦労が全て失われます。

ボタン以外のオブジェクトの乱造でも同様ですので注意して下さい。

回答No.7

HohoPapa

#6に追記します。

私の示したコードは、
複写元の行を特定し、複写先セルを選択する順番です。

もし、
複写先セルを選択し、その後、複写元の行を特定する順番を期待するのであれば
提示したコードを変更することで対応できます。

回答No.6

HohoPapa

>2000行に2000個ぐらい
これだけのボタンとコードを配置するのは面倒ですし
常識的には現実的じゃないだろうと思います。

私だったら、
コンテキストメニュー（右クリックして表示するメニュー）を使います。

後記コードが、
・コンテキストメニューを表示するコード
・コンテキストメニューを非表示するコード
・対象の行番号を取得するコード
・取得した行番号のAE列の値を
　　選択したセルに貼り付けるコードです。

Option Explicit

Dim TargetRow As Long

'コンテキストメニューを追加
Sub AddMenu()
　Dim Newb As CommandBarControl
　Set Newb = CommandBars("Cell").Controls.Add()
　With Newb
　　.Caption = "複写元データ取得"
　　.OnAction = "DataGet"
　End With
　Set Newb = CommandBars("Cell").Controls.Add()
　With Newb
　　.Caption = "複写元データ貼付"
　　.OnAction = "DataPut"
　End With
End Sub

'コンテキストメニューを削除
Sub DeleteMenu()
　On Error Resume Next
　CommandBars("Cell").Controls("複写元データ取得").Delete
　CommandBars("Cell").Controls("複写元データ貼付").Delete
　On Error GoTo 0
End Sub

'対象の行番号を取得
Sub DataGet()

　If ActiveCell.Column < 11 Then
　　MsgBox "K列以降のセルを右クリックしてください"
　　TargetRow = 0
　　Exit Sub
　End If

　TargetRow = ActiveCell.Column

End Sub

'選択した行番号のAE列(31列目)の値を選択したセルに複写
Sub DataPut()

　Dim rc As VbMsgBoxResult

　If TargetRow = 0 Then
　　MsgBox "複写元が未選択"
　　Exit Sub
　End If

　If ActiveCell.Column > 10 Then
　　MsgBox "カレンダーのセルをを右クリックしてください"
　　Exit Sub
　End If

　rc = MsgBox(Cells(TargetRow, 31).Value & "を貼り付けます", vbYesNo + vbQuestion)
　If rc = vbNo Then Exit Sub
　'ActiveCell.Value = Cells(TargetRow, 31).Value
　'または
　'Cells(TargetRow, 31).Copy ActiveCell
　'または
　'Cells(TargetRow, 31).Copy
　'ActiveCell.PasteSpecial Paste:=xlPasteValues
　'Application.CutCopyMode = False

End Sub