Excel VBA

質問

Sheet1は個票データで、
第一列にid番号、第二・三・四列にそれぞれの属性の種類が（数値で）入っているとします。
（例　id 性別 年齢 身長）

Sheet2には、
第一・二・三列にSheet1の第二～三列に対応する属性の種類が辞書的順番に網羅されていて、
第四列に、第一～三列に対応する値が入っているとします。
（例　性別 年齢 身長 体重）

このときSheet1の第五列に、Sheet2の第四列から対応する値を貼り付けるには、
どのようなプログラムを書けばよろしいでしょうか。

よろしくお願いします。

回答No.1

keithin · ベストアンサー

ご利用のエクセルのバージョンに指定がありませんので、とりあえずエクセル２００７以降を使います

シート１のＥ２には
=SUMIFS(Sheet2!D:D,Sheet2!A:A,B2,Sheet2!B:B,C2,Sheet3!C:C,D2)
または
=IF(COUNTIFS(Sheet2!A:A,B2,Sheet2!B:B,C2,Sheet3!C:C,D2),SUMIFS(Sheet2!D:D,Sheet2!A:A,B2,Sheet2!B:B,C2,Sheet3!C:C,D2),"")
と数式を記入し、以下コピーします。

回答No.4

High_Score

No3です。訂正があります。
End Subの上に　End With　を追加してください。

また、データはどちらのシートも２行目から始まるものと仮定してます。

回答No.3

High_Score

重複のデータは無いと仮定します。つまりある行で１回該当データがあればそこで探すのを止めて次に移ります。

Sub Macro1()

　Dim LastRow1 As Long, LastRow2 As Long, i1 As Long, i2 As Long
LastRow1=Worksheets("Sheet1").Cells(Rows.Count,1).End(xlUp).Row 'シートデータ最終行取得
LastRow2=Worksheets("Sheet2").Cells(Rows.Count,1).End(xlUp).Row
With Worksheets("Sheet2")
for i1=2 to LastRow1
for i2=2 to LastRow2
　　　　'Sheet1の２～４列がSheet2の１～３列と一致したら、Sheet2の５列をSheet1の４列に記入
If Worksheets("Sheet1").Cells(i1,2).Value=.Cells(i2,1).Value _
and Worksheets("Sheet1").Cells(i1,3).Value=.Cells(i2,2).Value _
and Worksheets("Sheet1").Cells(i1,4).Value=.Cells(i2,3).Value Then
Worksheets("Sheet1").Cells(i1,5).Value=.Cells(i2,4).Value
Exit for
End If
Next i2
Next i1

End Sub

回答No.2

tom04

こんばんは！

＞（例　id 性別 年齢 身長）
＞（例　性別 年齢 身長 体重）

Sheet1のA列＝「ID」・B列＝「性別」・C列＝「年齢」・D列＝「身長」が入っている。
Sheet2のA列＝「性別」・B列＝「年齢」・C列＝「身長」・D列＝「体重」が入っている。

Sheet1のE列に各行の性別・年齢・身長の一致するSheet2の「体重」を表示させたい！
という解釈です。

両Sheetとも1行目が項目行でデータは2行目以降にあるとします。
標準モジュールです。

Sub Sample1()
Dim i As Long, lastRow1 As Long, lastRow2 As Long
Dim c As Range, wS As Worksheet
Set wS = Worksheets("Sheet2")
Application.ScreenUpdating = False
With Worksheets("Sheet1")
lastRow1 = .Cells(Rows.Count, "A").End(xlUp).Row
.Range("A:A").Insert
Range(.Cells(2, "A"), .Cells(lastRow1, "A")).Formula = "=C2&D2&""_""&E2"
lastRow2 = wS.Cells(Rows.Count, "A").End(xlUp).Row
wS.Range("A:A").Insert
Range(wS.Cells(2, "A"), wS.Cells(lastRow2, "A")).Formula = "=B2&C2&""_""&D2"
For i = 2 To lastRow1
Set c = wS.Range("A:A").Find(what:=.Cells(i, "A"), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
.Cells(i, "F") = c.Offset(, 4)
End If
Next i
.Range("A:A").Delete
wS.Range("A:A").Delete
Application.ScreenUpdating = True
End With
End Sub

※　万一、3条件が一致するデータが複数ある場合は最初のデータが表示されます。

こんな感じで良いのでしょうか？m(_ _)m