EXCEL VBAでできますか？

質問

皆様おはようございます。時々質問させていただきよい回答を得られまして
感謝しております。今回質問させていただきたいのは質問する僕のほうでもうまく説明できるかどうかわかりませんが・・・・

EXCELのSheet1のセルA1に数値205があります。右隣のSheet2にB2から下にかけて205、206、205、199、197と数値があります。
このSheet1の数値205と同じ値をSheet2から選択してそのセルの番地を
Sheet1のD1から下に表示するという方法はありますでしょうか？
この設問でいうとSheet1のD1、D2にSheet2のB2、Sheet2のB3と表示される
と思うのですが・・・
どうか回答をよろしくお願いいたします。

回答No.1

merlionXX · ベストアンサー

単純にやると、こんな感じでしょうか （^∇^）v

Sub test01()
With Sheets("Sheet2")
X = .Cells(65536, "B").End(xlUp).Row
For i = 2 To X
If .Cells(i, "B") = Sheets("Sheet1").Cells(1, "A") Then
n = n + 1
Sheets("Sheet1").Cells(n, "D") = .Name & "!" & .Cells(i, "B").Address(False, False)
End If
Next
End With
End Sub

お礼

ご回答ありがとうございました。このとおりやってみたら確かに
sheet1にsheet2の値がきます。驚きと感激です。
本当にありがとうございました。

回答No.4

noname#52504

Sheet1、D1セルで
="B"&SMALL(IF(Sheet2!$B$1:$B$1000=$A$1,ROW(Sheet2!$B$1:$B$1000),""),ROW())
を配列数式として入力(Ctrl+Shift+Enter)してフィル。
といった方法もあります。

エラー処理をつけるなら、
条件付書式で見えなくするか、
=IF(COUNTIF(Sheet2!$B$1:$B$1000,$A$1)<ROW(),"","B"&SMALL(IF(Sheet2!$B$1:$B$1000=$A$1,ROW(Sheet2!$B$1:$B$1000),""),ROW()))
といった感じでしょうか。

#3さんの方法が標準的だと思いますが、
作業列を使いにくい状況もままありますので参考までに。

お礼

ご回答ありがとうございます。
たくさんの方のご回答ありがとうございました。
本当に皆様のよきアドバイスによりこの問題は解決いたしました。
ありがとうございました。

回答No.3

imogasi

VBAでも簡単です。
Sheet2のA列の各行について、上から最終行までSheet1のA1の値と比較を繰り返せば済むことです。Findなどのメソッドを使うホ法もあります。Sheet2のB列のデータ入力済み最終行の捉え方ぐらいが、質問になりそうですが。＃１等で既に出ているので略。
ーーー
関数でもできます。
Sheet2のC列（空き列）に
=IF(B2=Sheet1!$A$1,MAX($C$1:C1)+1,"")
と入れて最終行まで式を複写。
Sheet1のB2に
="B"& MATCH(ROW()-1,Sheet2!$C$1:$C$100,0)
と入れて、C列の最大数行文式を複写します。＄100の部分は適当に。
結果
B3
B6
以上imogasi方式　です。私の回答に同様問題が多数回答あり。
３行以下に式を複写すると、＃N/Aになりますが、それを防ぐには
=IF(row()-1>MAX(Sheet2!$c$1:$c$100,"",上記式）を加えてください。

お礼

ご回答ありがとうございます。
関数を使用するのですね？やってみます。

回答No.2

Musaffah

#1さんのマクロをパワーアップしてみました。
[ツール]-[マクロ]-[Visual Basic Editor]を開いて、プロジェクトエクスプローラ内にある"Sheet1"オブジェクトをダブルクリックして、以下の関数をコピペしてください。
すると、Sheet1のA1の値を変化する度に再計算するようになります。

Private Sub Worksheet_Activate()
Call check
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = 1 And Target.Column = 1 Then
Call check
End If
End Sub

Private Sub check()
Sheets("Sheet1").Columns("D:D").ClearContents
With Sheets("Sheet2")
n = 0
X = .Cells(65536, "B").End(xlUp).Row
For i = 1 To X
If .Cells(i, "B") = Sheets("Sheet1").Cells(1, "A") Then
n = n + 1
Sheets("Sheet1").Cells(n, "D") = .Name & "!" & .Cells(i, "B").Address(False, False)
End If
Next
End With
End Sub

お礼

ご回答ありがとうございます。
やってみます。本当にありがとうございました。