Excel VBA質問箱 IV

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

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


41327 / 76732 ←次へ | 前へ→

【40486】Re:検索して一致したらデータ入力
発言  ichinose  - 06/7/14(金) 18:45 -

引用なし
パスワード
   ▼涙 さん:
こんばんは。

>>シート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 main()
  Dim rng1 As Range
  Dim rng2 As Range
  Dim crng As Range
  Dim nrw As Long
  With Worksheets("シートA")
    Set rng1 = .Range("a2", .Cells(.Rows.Count, "a").End(xlUp))
    End With
  With Worksheets("シートB")
    Set rng2 = .Range("b2", .Cells(.Rows.Count, "b").End(xlUp))
    End With
  If rng1.Row > 1 Then
    If rng2.Row > 1 Then
     nrw = 0
     For Each crng In rng1
       If Evaluate("=SUM(EXACT(" & rng2.Address(, , , True) & "," & crng.Address(, , , True) & ")*1)") = 0 Then
        With rng2
          .Cells(.Rows.Count + 1 + nrw, 1).Resize(, 2).Value = crng.Resize(, 2).Value
          .Cells(.Rows.Count + 1 + nrw, 3).Value = 1000
          End With
        nrw = nrw + 1
        End If
       Next
    Else
     With rng2
       .Cells(2, 1).Resize(rng1.Rows.Count, 2).Value = rng1.Resize(, 2).Value
       .Cells(2, 3).Resize(rng1.Rows.Count).Value = 1000
       End With
     End If
    End If
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 お礼

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