Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

41332 / 76732

←次へ　｜　前へ→


	【40481】検索して一致したらデータ入力

涙 - 06/7/14(金) 15:33 -


	引用なし

	パスワード

いつもお世話になっています。
今回も処理方法が分からず苦労しています。
どうしたらいいか教えてください。

以下のようなシートが2枚あります。
シートAにリストがあって、シートBに
データが無い場合はシートBには
（日付は入れず、）D列に1000と表示させ
たいと思っています。

シートAのC列値を検索キーとして
Findメソッドを使いたいと思っています。
尚、サンプルではDDDは一つですが、実データ
ではいくつもあります。

シートＡ(リスト）

　　　　A　　　　Ｂ　　　　Ｃ
1　　　　　　ID1　　　　ID2　　　　　　氏名
2　　　　　　　AAA　　　　111　　　　　中田
3　　　　BBB　　　　222　　　　　宮本
4　　　　CCC　　　　333　　　　　中村
5　　　　DDD　　　　444　　　　　川口

シートＢ
　　　　A　　　　Ｂ　　　　Ｃ　　　　Ｄ　　　　
1　　年月日　　　　ID1　　　　ID2　　料金
2　　　6/1　　　　AAA　　　　　111　　　　6300　　　　
3　　　6/3　　　　BBB　　　　　222　　　　3000
4　　　6/5　　　　CCC　　　　　333　　　　4000
5　　　6/7　　　　AAA　　　　　111　　　　9000
6　　　6/10　　　　CCC　　　　　333　　　　4000
4　　　6/12　　　　BBB　　　　　222　　　　8000
8　　　6/20　　　　AAA　　　　　111　　　　7000

＜ほしい結果＞
シートB
　　　　A　　　　Ｂ　　　　Ｃ　　　　Ｄ　　　　
1　　年月日　　　　ID1　　　　ID2　　料金
2　　　6/1　　　　AAA　　　　　111　　　　6300　　　　
3　　　6/3　　　　BBB　　　　　222　　　　3000
4　　　6/5　　　　CCC　　　　　333　　　　4000
5　　　6/7　　　　AAA　　　　　111　　　　9000
6　　　6/10　　　　CCC　　　　　333　　　　4000
4　　　6/12　　　　BBB　　　　　222　　　　8000
8　　　6/20　　　　AAA　　　　　111　　　　7000
8　　　　　　　　DDD　　　　　444　　　　1000

過去ログから参考になるコードを探して
以下のように改良してみましたが、全く動きません。

Sub 見つけたら1000円()

Dim adrs As String, addr As Range
Dim theadd As String, R As Range

'Application.ScreenUpdating = False

For i = 2 To Lastrow = Rows.Count
adrs = Sheets("シートA").Cells(i, 1).Value
With Worksheets("シートB")
　　 Set addr = .Range("B1:B35000").Find(adrs, , xlValues, xlPart)
　　 If Not addr Is Nothing Then
　　　　theadd = addr.Address
　　　　Set R = addr
　　　　Do
　　　　　Set addr = .Range("B1:B35000").FindNext(addr)
　　　　　Set R = Union(R, addr)
　　　　Loop Until theadd = addr.Address
　　　　 theadd.Offset(, 5).Value = "1000"
　　　　.Activate
　　　　R.Activate
　　 Else
　　　　Exit For
　　　　
　　 End If
End With
Application.ScreenUpdating = True
Set R = Nothing: Set addr = Nothing
Next

End Sub

0 hits

▼

【40481】検索して一致したらデータ入力 涙 06/7/14(金) 15:33

≪