こんばんは!
VBAになってしまいますが、一例です。
画像の文字が小さくてはっきり見えないのですが、
Sheet1のデータはA~C列までで2行目以降にある。
Sheet2の2行目「型名」は画像では3種類だけですが、実際は200程度ある!
というコトですよね?
とりあえず「型名」も表示させるようにしてみました。
ALT+F11キー → 画面左下の「This Workbook」をダブルクリック → VBE画面に
↓のコードをコピー&ペーストしてマクロを実行してみてください。
(Alt+F8キー → マクロ → マクロ実行です)
Sub test() 'この行から
Dim i, j, k As Long
Dim ws1, ws2 As Worksheet
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
Application.ScreenUpdating = False
k = ws2.Cells(Rows.Count, 1).End(xlUp).Row
j = ws2.Cells(2, Columns.Count).End(xlToLeft).Column
If k > 2 Then
ws2.Rows(3 & ":" & k).ClearContents
End If
If j > 1 Then
Range(ws2.Cells(2, 2), ws2.Cells(2, j)).ClearContents
End If
For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
If WorksheetFunction.CountIf(ws2.Rows(2), ws1.Cells(i, 3)) = 0 Then
ws2.Cells(2, Columns.Count).End(xlToLeft).Offset(, 1) = ws1.Cells(i, 3)
End If
Next i
k = 2
For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
For j = 2 To ws2.Cells(2, Columns.Count).End(xlToLeft).Column
If ws1.Cells(i, 3) = ws2.Cells(2, j) Then
k = k + 1
ws2.Cells(k, 1) = ws1.Cells(i, 1)
ws2.Cells(k, j) = ws1.Cells(i, 2)
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub 'この行まで
※ 関数でないので、Sheet1のデータ変更があってもSheet2には反映されません。
Sheet1の変更があるたびにマクロを実行する必要があります。
外していたらごめんなさいね。m(_ _)m
お礼
tom04さん、いつも有り難うございます。完璧な物が出来ました有り難うございました。連絡遅れて申し訳ありません。