Excel VBA質問箱 IV

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

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


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

41301 / 76732

←次へ　｜　前へ→


	【40512】Re:検索して一致したらデータ入力

涙 - 06/7/15(土) 12:48 -


	引用なし

	パスワード

▼ichinose さん：
有難うございました。

質問の内容が分かりにくくて申し訳ないです。
試してみましたところ、DDDだけではなく
リストにあった全てのデータが以下のように
表示されてしまいました。

年月日　　　　ID1　　　　ID2　　　　料金
6月1日　　　　AAA　　　　111　　　　6300
6月3日　　　　BBB　　　　222　　　　3000
6月5日　　　　CCC　　　　333　　　　4000
6月7日　　　　AAA　　　　111　　　　9000
6月10日　　　　CCC　　　　333　　　　4000
6月12日　　　　BBB　　　　222　　　　8000
6月20日　　　　AAA　　　　111　　　　7000
　　　　AAA　　　　　　111　　　　1000
　　　　BBB　　　　　　222　　　　1000
　　　　CCC　　　　　333　　　　1000
　　　　DDD　　　　　444　　　　1000

いろいろ試して見ます。

>▼涙さん：
>こんばんは。
>
>>>シートＡ(リスト）
>>
>>　　　　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 main()
>　　Dim rng1 As Range
>　　Dim rng2 As Range
>　　Dim crng As Range
>　　Dim nrw As Long
>　　With Worksheets("シートＡ")
>　　　 Set rng1 = .Range("a2", .Cells(.Rows.Count, "a").End(xlUp))
>　　　 End With
>　　With Worksheets("シートＢ")
>　　　 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
>
>で試してみてください

1 hits

▼

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