数値を検索して、その隣に転記をするマクロを作りたい

質問

写真のようにA2に入力した列を検索して、B２の内容を入力するようなマクロをつくりたいのですが、どのように書けばよいのでしょうか？

手順としては、

１）B２の値をコピー
２）A列の番号を検索
２）その一つよこのセルにB2のデータをペースト

という簡単なもののはずなのに全く思い浮かびません。

回答No.4

keithin · ベストアンサー

一回マクロを忘れましょう。
そもそもアナタがご自分の目と手を動かして自分でその仕事をするとしたら，いったいどういう事を考えて何をすれば，目的を達成できますか？
ご自分で用意したサンプルで，いったいどういう具合に何をしたら漏れなく仕事が片付きますか？アタマを使ってまず考えます。

シンプル：
sub macro1()
　dim i as long
　for i = 6 to range("A65536").end(xlup).row
　　if cells(i, "A") = range("A2") then
　　　range("B" & i) = range("B2")
　　end if
　next i
end sub

ループしない（高速）：
sub macro2()
　with range("B6:B" & range("A65536").end(xlup).row)
　　.formula = "=IF(A6=$A$2,$B$2,"""")"
　　.value = .value
　end with
end sub

趣味：
sub macro3()
　range("A1") = "dammy"
　range("A:B").autofilter field:=1, criteria1:=range("A2").value
　range("B2:B" & range("A65536").end(xlup).row) = range("B2").value
　range("A1:B1").clearcontents
end sub

もしも条件に合致するセルが「１つしかない」事が判っていて，かつ「必ず一つある」事も分かっているなら
sub macro4()
　dim r
　r = application.match(range("A2"), range("A6:A9999"), 0)
　cells(r + 5, "B") = range("B2")
end sub

お礼

ご回答ありがとうございました。
私のレベルでは理解するのに時間はかかりそうだと思いますが、少しずつ進めていこうと思います。
macro4は絶妙でした。
まさに、私がしたい事がぴったり出来る方法で勉強になりました。

回答No.3

imogasi

質問の書き方の改善。　
下記が良いだろう。
Ａ２に検索する数を入力する。
Ａ６からＡｘまでを検索して、見つかった行のＢ列の値をＢ２にセット（代入）する。
ーー
たった２行。１行にもなる。
＞全く思い浮かびません。
ＶＢＡの経験を積んで勉強しないと。
＝＝
ほかにボタンのクリックイベントで、上記を実行する、に変えたいなら、ボタンのクリックイベントを勉強のこと。
上記のＡ１００は、例で１００にしているが、Ａ列データ最終行なら、そのとらえ方知っているか。
Sub test01()
x = Range("A2")
d = Range("A65536").End(xlUp).Row
Range("B2") = Range("A6:A" & d).Find(x).Offset(0, 1)
End Sub

お礼

ご回答ありがとうございました。
私のレベルでは理解するのに時間はかかりそうだと思いますが、少しずつ進めていこうと思います。
マクロの記録をしてそれを見ながら徐々に進めて参りたいと思います。

回答No.2

noname#146604

中身的には

Sub macro()

Cells(2, 2) = Cells.Find(Cells(2, 1), lookat:=xlWhole, after:=Cells(4, 1), searchorder:=xlByRows).Offset(0, 1)

End Sub

お礼

ご回答ありがとうございました。
私のレベルでは理解するのに時間はかかりそうだと思いますが、少しずつ進めていこうと思います。
シンプルなコードで勉強になりました。

回答No.1

tom04

こんばんは！
色々方法はあるかと思いますが・・・
一例です。

配置は画像通りとします。

Private Sub CommandButton1_Click()
Dim i, j As Long
j = Cells(Rows.Count, 1).End(xlUp).Row
Range(Cells(6, 2), Cells(j, 2)).ClearContents
If WorksheetFunction.CountIf(Range(Cells(6, 1), Cells(j, 1)), Cells(2, 1)) Then
i = WorksheetFunction.Match(Cells(2, 1), Range(Cells(6, 1), Cells(j, 1)), False)
Cells(i + 5, 2) = Cells(2, 2)
End If
End Sub

※　LOOPさせる場合は

Private Sub CommandButton1_Click()
Dim i As Long
i = Cells(Rows.Count, 1).End(xlUp).Row
Range(Cells(6, 2), Cells(i, 2)).ClearContents
For i = 6 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(i, 1) = Cells(2, 1) Then
Cells(i, 2) = Cells(2, 2)
End If
Next i
End Sub

こんな感じではどうでしょうか？m(_ _)m

お礼

ご回答ありがとうございました。
私のレベルでは理解するのに時間はかかりそうだと思いますが、少しずつ進めていこうと思います。