別シート同士のセルを比較して一致したらセルに代入をしたいと考えています

質問

別シート同士のセルを比較して一致したらセルに代入をしたいと考えています。

excelのＶＢＡを使って行いたいのです

book1のsheet1に

Ａ列　　　　　Ｂ列　　　　Ｃ列　　　　　　　Ｄ列
2000　　　　　NEC 　　VL100
5000　　　　　Sony 　　vaio-200
3000　　　　　東芝　 　　 letsnote

単価、メーカー、型番、空き列があり
200行くらいです。

book2のsheet1に

同じく、単価、メーカー、型番がありますが

単価がsheet1とは異なり、違うメーカー型番の情報が
4000行くらいあります

Ａ列　　　　　Ｂ列　　　　Ｃ列
5225　　　　　ＸＸＸＸ　　　ＸＸＸＸ
2200　　　　　NEC 　　VL100
5200　　　　　Sony 　　vaio-200
2684　　　　　ＸＸＸＸ　　　ＸＸＸＸ
2566　　　　　ＸＸＸＸ　　　ＸＸＸＸ
6000　　　　　東芝　 　　 letsnote

・・・・・・
・・・・・・

そこで

book1のＢ，Ｃ列のメーカーと型番が一致するものを

book2のsheet1のB,C列から探し

一致したら、book1のsheet1のＤ列に
book2 sheet1のＡ列の値を入れのです。

参考になるスクリプトを教えて頂けると大変助かります、

よろしくお願い致します。

回答No.7

mitarashi · ベストアンサー

#6です。マスターに空欄があるというのは想定外でした。

コードの最初の部分を下記の通り置き換えれば良いでしょう。
With Workbooks("Book2.xls").Sheets("Sheet1")
buf1 = .Range(.Range("A1"), .Range("A" & .Rows.Count).End(xlUp)).Resize(, 2)
End With

お礼

おお神様、仏様、mitarashi様

おかげ様で思い通りの事が出来ました。

配列数式についてまだ理解が出来ていませんが、

シンプルなコードでこんな事が出来るのですね。

これを機会にもう少し掘り下げて勉強します。

ほんとに有難う御座いました！！

回答No.6

mitarashi

#4,5です。
話は簡単で、#5のコードで、

If (buf1(j, 2) Like ("*" & buf2(i, 2) & "*")) * (buf1(j, 2) Like ("*" & buf2(i, 3) & "*")) Then
buf2(i, 4) = buf1(j, 1)
'一つめを見つけたら探索打ち切り
Exit For
End If
と、一行変更すれば良いと思います。
ただし、型番だけでなく、メーカー名もAND条件としています。

お礼

mitarashi様

頂いたコードで出来ました！

ただBook2のシートに空白行がまばらにあり、
空白行で停止してしまいます。

最下行まで検索して条件が合えば単価を
書き込む方法があればお教え頂きたいのですが.......

たびたび条件を変えてしまい心苦しく思います、

なにかよきアドバイスを頂きたく存じます。

回答No.5

mitarashi

#4です。ちょっと悪のりして．．．
配列数式でやっているのは結局こういう事なんだなと、やってみました。
Sub test()
Dim buf1 As Variant, buf2 As Variant
Dim myRange As Range
Dim i As Long, j As Long

buf1 = Workbooks("Book2.xls").Sheets("Sheet1").Range("A1").CurrentRegion
With Workbooks("Book1.xls").Sheets("Sheet1")
Set myRange = .Range(.Range("A1"), .Range("A" & .Rows.Count).End(xlUp))
End With
Set myRange = myRange.Resize(, 4)
buf2 = myRange
For i = 1 To UBound(buf2, 1)
For j = 1 To UBound(buf1, 1)
If (buf2(i, 2) = buf1(j, 2)) * (buf2(i, 3) = buf1(j, 3)) Then
buf2(i, 4) = buf1(j, 1)
'一つめを見つけたら探索打ち切り
Exit For
End If
Next j
Next i
myRange = buf2
End Sub

お礼

ご回答いただいている皆様

すばらしいご回答、誠に有難う御座います、

皆様のお知恵を借りながらやっているのですが

重大な事に気が付きました。

book2のsheet1なのですが、

Ｂ列の文字とＣ列の文字は別々のセルではなく、同一のセルでした、

ですのでＣ列は無く、Ｂ列にメーカーと型番が一つの文字列として記載されていました。

Ａ列　　　　　　　　Ｂ列　　　
5225　　　　　ＸＸＸＸ　ＸＸＸＸ
2200　　　　　NEC 　VL100
5200　　　　　Sony 　vaio-200
2684　　　　　ＸＸＸＸ　ＸＸＸＸ
2566　　　　　ＸＸＸＸ　ＸＸＸＸ
6000　　　　　東芝　letsnote

上記のようにＢ列にメーカと型番が1つの文字列として書かれていました。

型番に関しては、メーカーとか関係なく、唯一無二のものとして型番で検索すれば
重複は無いものとして、

Book1のsheet1のＣ列の文字を部分一致でbook2のＣ列から探さないと駄目なことに

気がつきました。

その場合の比較の仕方はどのようにすれば宜しいでしょうか？？

この結果に皆様あきれられておられると思いますが、今一度お知恵拝借させて頂ければ

大変助かります。

何卒お願い申し上げます。

回答No.4

mitarashi

VBAでやる範疇に入らないかもしれませんが、最近配列数式に凝っています。ご参考まで。
別ブックにつけた名前を使っているので、汎用化するにはもう一工夫必要です。
また、条件を満足するものが複数有ると、足し算されてしまいます。
Sub test()
Dim refRange As Range, targetRange As Range, myCell As Range

Set refRange = Workbooks("Book2.xls").Sheets("Sheet1").Range("A1").CurrentRegion
Workbooks("Book2.xls").Names.Add Name:="data", RefersTo:=refRange
With Workbooks("Book1.xls").Sheets("Sheet1")
Set targetRange = .Range(.Range("A1"), .Range("A" & .Rows.Count).End(xlUp))
End With
Set targetRange = targetRange.Offset(0, 3)
For Each myCell In targetRange.Cells
myCell.FormulaArray = _
"=SUM((INDEX(Book2!data,,2)=Sheet1!RC[-2])*(INDEX(Book2!data,,3)=Sheet1!RC[-1])*(INDEX(Book2!data,,1)))"
Next myCell
targetRange.Value = targetRange.Value
Workbooks("Book2.xls").Names("data").Delete
End Sub

回答No.3

imogasi

Book1のメーカーと型番から、メーカーと型番の２列が一致するものを探すのは、相当むずかしい。
結合した列を作ればVLOOKUP関数やFindメソドでで出来ると思う。
ーー
本当はAccessなどで使われるSQLなどのデータベース検索言語のお世話にならないとすなおな処理にならない。エクセルでもMsクエリと言うのがあるので使えるかもしれないが。
ーー
Book2（元データ）を、メーカー＋型番でソートしておけば、そのキーでユニークである保証があれば
FindやVLOOKUP関数が使えるかも。メーカーの行郡の先頭行を見つけ、その行から下での最初に出現する型番のデータを持ってくるロジック。そのメーカでは、その型番がない場合もあるので、型番が見つかればそのメーカーが求めるものかチェックは必要。
ーー
エクセルに「フィルタオプションの設定」がある。これをマクロの記録を採って改良し、使えるかもしれない。
ーーー
もうひとつはBook1,Book2をメーカー＋型番でソートし、両ファイルをメーカー＋型番キーでマッチングさせて処理できる。しかしいまどきの人は、このロジックに慣れて居ないと思うので難しいかも。
判ればこれが一番処理も早い（ソート時間を除き）し処理も提携パターンで誤りが少ないと思うが。
ーー
質問者のVBAの技量がわからないので、どれが良いか決めかねる。初心者には、どれも判ってもらうのが難しい。

回答No.2

aloha88600

検証してないけどこんなかんじ！

数字を比較する場合は注意！
単純比較だとヒットしない場合がある！
その場合は関数で型変換！（今回省略）

共にブックを開いていることが条件

Sub 比較()
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim i As Long
Dim k As Long
Dim Endrow As Long
Dim c As Range

Set Ws1 = Workbooks("Book1.xls").Worksheets("Sheet1")
Set Ws2 = Workbooks("Book2.xls").Worksheets("Sheet1")

Endrow = Ws2.Range("a65536").End(xlUp).Row
i = 2
Do Until Ws1.Cells(i, 1).Value = ""
For Each c In Ws2.Range("a2:a" & Endrow)
If Ws1.Cells(i, 2).Value = c.Offset(0, 1).Value Then
If Ws1.Cells(i, 3).Value = c.Offset(0, 2).Value Then
Ws1.Cells(i, 4).Value = c.Value
End If
End If
Next
Loop

End Sub

回答No.1

nattocurry

もし、book2のほうに、

3000　　NEC　　VL100
4000　　NEC　　VL100

というように、NEC＋VL100というデータが複数あって、単価が違う場合は、どのような処理をするのでしょうか？

メーカーと型番が同じデータは重複することは絶対にない、とか、メーカーと型番が同じデータの単価は必ず同じ、とか、そういう制限はありますか？

補足

86ft3kr様

メーカーと型番が同じデータは無く、

同じメーカー、同じ型番で違う単価は無いものと想定します、

仮にあったとしたら、上書きでかまいません。