Excel VBA質問箱 IV

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

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


41336 / 76736 ←次へ | 前へ→

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

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

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

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


シートA(リスト)

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


シートB
    A    B    C    D    
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    B    C    D    
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 質問
【40486】Re:検索して一致したらデータ入力 ichinose 06/7/14(金) 18:45 発言
【40512】Re:検索して一致したらデータ入力 06/7/15(土) 12:48 質問
【40517】Re:検索して一致したらデータ入力 ichinose 06/7/15(土) 15:10 発言
【40534】Re:検索して一致したらデータ入力 06/7/15(土) 22:37 お礼
【40544】Re:検索して一致したらデータ入力 ichinose 06/7/16(日) 8:56 発言
【40564】Re:検索して一致したらデータ入力 06/7/17(月) 22:14 お礼
【40515】Re:検索して一致したらデータ入力 Kein 06/7/15(土) 13:35 回答
【40520】Re:検索して一致したらデータ入力 06/7/15(土) 18:01 質問
【40562】Re:検索して一致したらデータ入力 kobasan 06/7/17(月) 16:20 発言
【40563】Re:検索して一致したらデータ入力 kobasan 06/7/17(月) 20:53 発言
【40565】Re:検索して一致したらデータ入力 06/7/17(月) 22:26 お礼

41336 / 76736 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free