dポイントプレゼントキャンペーン実施中!

Sheet1にある表の右側にSheet2の表のデータをつけたいのですが、
Sheet1のアイテムコードに一致するSheet2の行をそのまま後ろに付けたいです。
また、できれば一致しないものが欄外に並ぶなど分かるようになると助かります。
実際の資料はアイテムコード数が1万を超えるため適切な関数を教えてください。
アドバイスお願いいたします。

「エクセル 異なったシートで一部の条件が一」の質問画像

A 回答 (1件)

こんばんは!



COUNTIF関数とVLOOKUP関数などで対応できそうですが、
手っ取り早くVBAでの一例です。

標準モジュールにしてください。

Sub Sample1()
Dim myDic As Object
Dim myR, myAry
Dim i As Long, lastRow As Long
Dim myStr As String, wS As Worksheet

Set myDic = CreateObject("Scripting.Dictionary")
Set wS = Worksheets("Sheet2")
With Worksheets("Sheet1")
.Range("F:J").ClearContents
.Range("F1:J1").Value = wS.Range("A1:E1").Value
lastRow = wS.Cells(Rows.Count, "B").End(xlUp).Row
myR = Range(wS.Cells(2, "A"), wS.Cells(lastRow, "E"))
For i = 1 To UBound(myR, 1)
If Not myDic.exists(myR(i, 2)) Then
myDic.Add myR(i, 2), myR(i, 1) & "_" & myR(i, 3) & "_" & myR(i, 4) & "_" & myR(i, 5)
End If
Next i
lastRow = .Cells(Rows.Count, "B").End(xlUp).Row
myR = Range(.Cells(2, "B"), .Cells(lastRow, "J"))
For i = 1 To UBound(myR, 1)
If myDic.exists(myR(i, 1)) Then
myAry = Split(myDic(myR(i, 1)), "_")
myR(i, 5) = myAry(0)
myR(i, 6) = myR(i, 1)
myR(i, 7) = myAry(1)
myR(i, 8) = myAry(2)
myR(i, 9) = myAry(3)
End If
Next i
Range(.Cells(2, "B"), .Cells(lastRow, "J")) = myR
End With
Set myDic = Nothing
MsgBox "完了"

End Sub

※ 関数でないので、
データ変更があるたびにマクロを実行する必要があります。m(_ _)m
    • good
    • 0
この回答へのお礼

ありがとうございます。無事できました!!

お礼日時:2017/12/08 09:06

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!