|
ichinoseさんの種類項目の無重複Listの取り方を別の方法で行っています
Option Explicit
Sub Macro2()
Dim i As Long
Dim vntList As Variant
Dim strEmn As String
With Range("A1", Cells(Rows.Count, "A").End(xlUp))
'配列に種類列を取得
vntList = .Value
'データが無い場合
If VarType(vntList) <> vbArray + vbVariant Then
Exit Sub
End If
'列挙文字列に初期値設定
strEmn = vbTab
'種類列の2番目から最後まで繰り返し
For i = 2 To UBound(vntList, 1)
'列挙文字列に現在の種類が無い場合
If InStr(1, strEmn, vbTab & vntList(i, 1) & vbTab, vbTextCompare) = 0 Then
'列挙文字列に種類を追加
strEmn = strEmn & vntList(i, 1) & vbTab
End If
Next i
'列挙した種類を配列に変換
vntList = Split(Mid(strEmn, 2, Len(strEmn) - 2), vbTab)
With .Resize(, 3)
.AutoFilter
For i = 0 To UBound(vntList, 1)
.AutoFilter Field:=1, Criteria1:=vntList(i)
ActiveSheet.PrintPreview
' activesheet.printout ↑プレビューしてあります
Next i
.AutoFilter
End With
End With
End Sub
|
|