マトリックス作成

質問

表現（説明）が難しいので、写真添付しました。　シート１のようなデータ500件程あります、型名が200種類程あります。シート２のようなマトリックスを作成したいです。ご教授ください

回答No.1

tom04 · ベストアンサー

こんばんは！
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さん、いつも有り難うございます。完璧な物が出来ました有り難うございました。連絡遅れて申し訳ありません。

回答No.2

MarcoRossiItaly

ピボットテーブルでも。図のように項目をドラッグして配置すれば、「シャフト」のみのリストが得られます。同様に「シャフト1」のみ、「ボルト」のみの表示にもクリックのみで切り替えれます。

フィルタ（オートフィルタ）と一味違うのは、A列の種類ごとにB列が並べられていること。つまり、元々A列がバラバラな順番ではなく、規則正しく並んでいるならば、オートフィルタでも同じ表が作れることになります。