■

http://q.hatena.ne.jp/1281145035

実行したいキャラクターのシートをアクティブにして、抽出（）を実行すると
各ジャンル☆最大のアイテム以外を非表示にするマクロです。
非表示にしたアイテムをもう一度表示するには、全表示（）を実行してください。
※処理はちょっと重いです。

Sub 抽出()
    Dim i As Long
    Dim lastRow As Long
    Dim r1 As Long
    Dim r2 As Long
    Dim r3 As Long
    Dim r4 As Long
    
    Application.ScreenUpdating = False
    
    With ActiveSheet
        lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
            
        For i = 2 To lastRow
            If .Cells(i, 1).Value = "ヘッド" And .Cells(i, "H").Value > r1 Then
                r1 = .Cells(i, "H").Value
            End If
            If .Cells(i, 1).Value = "ボディ" And .Cells(i, "H").Value > r2 Then
                r2 = .Cells(i, "H").Value
            End If
            If .Cells(i, 1).Value = "アクセサリ1" And .Cells(i, "H").Value > r3 Then
                r3 = .Cells(i, "H").Value
            End If
            If .Cells(i, 1).Value = "アクセサリ2" And .Cells(i, "H").Value > r4 Then
                r4 = .Cells(i, "H").Value
            End If
        Next i
        
        For i = lastRow To 2 Step -1
            If Not ((.Cells(i, 1).Value = "ヘッド" And .Cells(i, "H").Value = r1) Or _
                (.Cells(i, 1).Value = "ボディ" And .Cells(i, "H").Value = r2) Or _
                (.Cells(i, 1).Value = "アクセサリ1" And .Cells(i, "H").Value = r3) Or _
                (.Cells(i, 1).Value = "アクセサリ2" And .Cells(i, "H").Value = r4)) Then
                .Rows(i).Hidden = True
            End If
        Next i
    End With
    
    Application.ScreenUpdating = True
End Sub


Sub 全表示()
    Dim i As Long
    Dim lastRow As Long
    
    Application.ScreenUpdating = False
    
    With ActiveSheet
        lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        For i = lastRow To 2 Step -1
            .Rows(i).Hidden = False
        Next i
    End With
    Application.ScreenUpdating = True
End Sub