選択したセルの値を別シートのセルに取り込む方法

質問

顧客情報を閲覧・印刷するためのフォームがsheet1とします。顧客の情報が入ったデータベースがsheet2とします。
以下のマクロでsheet2の48列目を空欄にして、48列のいずれかのセルに「出力」と入力すると、そのセルの行の値を出力結果というシートに渡すようにしています。取り込んだ行の顧客番号をsheet1のmach関数の参照先に指定して、index関数で各項目に取り込むようにしています。
Worksheets("sheet2").Activate
Dim i, LastRow As Long
LastRow = Cells(Rows.Count, 48).End(xlUp).Row
For i = 1 To LastRow
If Cells(i, 48) = "出力" Then
Rows(i).Copy Sheets("出力結果").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End If
Next i

もう少しこれを改良して、Sheet2の顧客番号の入っている1列目の任意のセルを選択して、sheet1のmatch関数の参照先（例としてK4）に選択した顧客番号を渡す方法はありませんでしょうか。sheet1は顧客番号だけ取得できれば、match・index関数でフォームが完成します。
VBAは初心者です。上記マクロは検索で調べて必要な個所をコピーして今の環境にアレンジしました。よろしくお願いします。

回答No.2

kagakusuki · ベストアンサー

>sheet1のmach関数の参照先

がsheet1のどのセルに表示される様になっているのか何も説明がないため、

>取り込んだ行の顧客番号をsheet1のmach関数の参照先に指定して、index関数で各項目に取り込む
>sheet1のmatch関数の参照先（例としてK4）に選択した顧客番号を渡す方法

と仰られてもさっぱり解りませんし、質問者様のご説明内容と、質問者様が作られたVBAでは結果を出力するためのシートが異なるシート名のシートとなっているために、結果を出力するためのシートがsheet1なのか、それとも「出力結果」というシート名のシートなのか判りませんので、質問者様が何をどうしたいのかという事が今一つ不明瞭なのですが、取りあえず、

>取り込んだ行の顧客番号をsheet1のmach関数の参照先に指定して、index関数で
>sheet1のmatch関数の参照先（例としてK4）に選択した顧客番号を渡す方法はありませんでしょうか。sheet1は顧客番号だけ取得できれば、match・index関数でフォームが完成

という箇所は無視して、

>Sheet2の顧客番号の入っている1列目の任意のセルを選択

してから、マクロを起動させると、Sheet2上で選択されているセルと同じ行にあるA列のセルに入力されている顧客番号と同じ顧客番号の行のデータを、すべて「出力結果」というシート名のシートにコピーしてしまうという事で宜しいのでしょうか?

　それで宜しければ以下の様になります。
　今仮に、Sheet2の3行目は各列の項目の項目名が入力されていて、実際の顧客番号等のデータは4行目以下に入力されているものとします。
　その場合、以下の様なVBAとなります。

Sub QNo9267513_選択したセルの値を別シートのセルに取り込む方法()

Const CopySheetName As String = "Sheet2" '元データシートのシート名
Const PasteSheetName As String = "出力結果" '転記先シートのシート名
Const CustomerNumColumn As String = "A" '顧客番号が入力されている列の列番号
Const ItemRow As Long = 3 '項目名が入力されている行の行番号
Dim CopySheet As Worksheet, PasteSheet As Worksheet, LastRow As Long _
, i As Long, c As Range, TargetValue As Variant, CopyRange As Range

For i = 0 To 1
If IsError(Evaluate("ROW('" & Array(CopySheetName, PasteSheetName)(i) & "'!A1)")) Then
MsgBox Array("元データが入力されている", "抽出結果を出力するための")(i) _
& "シートとして設定されている" & vbCrLf & vbCrLf _
& Array(CopySheetName, PasteSheetName)(i) & vbCrLf & vbCrLf & _
"というシート名のシートが見つかりません。" & vbCrLf _
& "マクロを終了します。", vbExclamation, "存在しないシート"
Exit Sub
End If
Next i
Set CopySheet = Sheets(CopySheetName)
Set PasteSheet = Sheets(PasteSheetName)

With CopySheet
LastRow = .Range(CustomerNumColumn & .Rows.Count).End(xlUp).row
.Activate
TargetValue = .Range(CustomerNumColumn & ActiveCell.row).Value
If LastRow <= ItemRow Or TargetValue = "" Or WorksheetFunction _
.CountIf(.Range(CustomerNumColumn & ItemRow + 1 & ":" _
& CustomerNumColumn & LastRow), TargetValue) = 0 Then
MsgBox "処理すべきデータがありません。" & vbCrLf _
& "マクロを終了します。", vbExclamation, "データ無し"
Exit Sub
End If
Set CopyRange = .Range("1:" & ItemRow)
End With

With Application
.ScreenUpdating = False
.Calculation = xlManual
End With

For Each c In CopySheet.Range(CustomerNumColumn _
& ItemRow + 1 & ":" & CustomerNumColumn & LastRow)
If c.Value = TargetValue Then Set CopyRange = Union(CopyRange, c)
Next c
Set CopyRange = CopyRange.EntireRow
With PasteSheet
.Activate
.Cells.Clear
CopyRange.Copy
With .Cells(1, 1)
.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
.PasteSpecial Paste:=xlPasteFormats
.PasteSpecial Paste:=xlPasteValues
End With
End With

With Application
.CutCopyMode = False
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

End Sub

お礼

ご回答いただき、ありがとうございます。
説明が下手で申し訳ございません。実際にどんなシートがあり、関数はどのように使っているか、詳細に説明すべきでした。今度から質問するときは、詳細に書くようにします。

上記マクロを実際に検証しました。sheet2のA列の任意のセルを選択してマクロを実行、出力結果シートに移動すると４行目に選択行のすべてのデータが取り込まれました。

このマクロのすべての意味を理解するには、マクロを勉強するしかないのですが、必要な個所をカスタマイズして今後に役立てたいと思います。

顧客情報を表示するフォーム上に、データ情報の入った別シートの選択したデータ行の番号を取得したいだけでした。

ネットで調べているうちに以下のマクロ文を見つけました。これで、AY１の値を入力フォームのK４が参照表示する（=sheet2!AY1）ようにして、K４に表示された行の数字をもとに、index関数で各項目を取得できるようになりました。

データ情報の入ったsheet2は行数がたくさんあるので、１行目を固定して、マクロボタンも１行目に置きました。後はエクセルのフィルター機能
を使って、必要な行を見つけ出せばいいようにしました。

Sub 行番号取得()

ActiveSheet.Range("AY1") = ActiveCell.Row

End Sub

上記マクロでmatch関数は不要になりました。有難うございます。

回答No.3

tsubu-yuki

エクセルでやるべき作業ではないような気もしますが（汗
まぁ、アクセスとか使える環境のほうが少ないか、ってことで。

単純ではありますが、仕立てようによってはやや面倒な話題ではあります。
例えばおっしゃるように
> Sheet2の顧客番号の入っている1列目の任意のセルを選択して
とするこのももちろん可能です。
が、これだと「動かしたくないのに」シート移動してしまうケースもあります。
同様にダブルクリックすると、なんてタイミングでも作成可能ですが、
これもまた予期せぬタイミングで処理が走る可能性がありますから、
個人的にはお勧めしません。
セルの値を編集するときにダブルクリックする方が圧倒的に多いので。

なので私個人としては
「選択しているセルの１列目（Ａ列）の値を他のセルに送るマクロを仕込んだボタン」
を実装することをお勧めします。
単に

Sub Sample()
　　　　Worksheets("Sheet1").Range("K4") = Cells(Selection.Row, 1)
　　　　Worksheets("Sheet1").Select
　　　　Range("K4").Select
End Sub

これだけのマクロです。
これをボタンに仕込んで、画面の上の方のどこかに配置、
スクロールしてもボタンが消えないように、
ウィンドウ枠の固定をしてやって準備完了です。

ActivateとかSelectionChangeとかBeforeDoubleClickのタイミングは便利ではありますが
エラー処理や例外処理などを仕込んでおかないと予期せぬ動きをします。
ご注意くださいませ。

お節介ながら、ご質問中でご提示のマクロ。
> sheet2の「48列目を空欄にして」、48列のいずれかのセルに「出力」と入力
とのことですから、出力したいタイミングだと
「出力（にこだわらず、何か）」が入力されているセルは、
４８列目には一カ所しかない、と考えられます。
この推察が正しければ、ここももっと単純に処理が可能です。
例えば、タイミングが適切かどうかは置いておいて、
　　　　Worksheets("sheet2").Activate
　　　　Rows(Cells(1, 48).End(XlDown).Row).Copy Sheets("出力結果").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
このような具合に、ご呈示の８行を２行に書き換えが可能です。
For~Next で回す必要は無さそうですね。

以上、ご参考までに。

回答No.1

FEX2053

セルがある場所の値は、

Selection.value

で得られますので、

Selelction.Copy Sheets("出力結果").Range("K4")

とかでコピーできちゃいますが・・・。

お礼

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

データ情報のあるシート上でデータ情報の最終列AY1に任意に選択したセルの行番号が出るマクロを作りました。

Sub 行番号取得()
ActiveSheet.Range("AY1") = ActiveCell.Row
End Sub

後は、AY１の値を顧客情報を表示するフォームの適当な見えないところに取り込み、問題解決しました。フォームはmatch関数が不要になり、index関数のみで済みました。

上記マクロはネット検索でなんとか調べて、アレンジしました。たった一行のマクロ文で済むことを知り、VBAを基本から勉強しないといけないと痛感しました。今現在は時間が無いため、必要な個所だけコピペして使いまわす方法をとってます。