• ベストアンサー

マトリックス作成

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

質問者が選んだベストアンサー

  • ベストアンサー
  • tom04
  • ベストアンサー率49% (2537/5117)
回答No.1

こんばんは! 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

okamoto6855
質問者

お礼

tom04さん、いつも有り難うございます。完璧な物が出来ました有り難うございました。連絡遅れて申し訳ありません。

すると、全ての回答が全文表示されます。

その他の回答 (1)

回答No.2

ピボットテーブルでも。図のように項目をドラッグして配置すれば、「シャフト」のみのリストが得られます。同様に「シャフト1」のみ、「ボルト」のみの表示にもクリックのみで切り替えれます。 フィルタ(オートフィルタ)と一味違うのは、A列の種類ごとにB列が並べられていること。つまり、元々A列がバラバラな順番ではなく、規則正しく並んでいるならば、オートフィルタでも同じ表が作れることになります。

すると、全ての回答が全文表示されます。

関連するQ&A