| |
"A1 に項目、A2:A20 にデータ"という状況で
Sub MyData_Ary()
Dim MyR As Range, C As Range
Dim Ary() As Variant
Dim i As Long
Set MyR = Range("A2:A20")
Range("A1:A20").AdvancedFilter xlFilterInPlace, , , True
Set MyR = MyR.SpecialCells(12)
For Each C In MyR
ReDim Preseve Ary(i): Ary(i) = C.Value
i = i + 1
Next
ActiveSheet.ShowAllData
Set MyR = Nothing
End Sub
で、配列 Ary が出来上がります。A2:A20 ぐらいのデータ量なら、フィルターでなく
ループで一つずつ見ていっても時間はかかりません。
Sub MyData_Ary2()
Dim C As Range
Dim Ary() As Variant
Dim i As Long
On Error Resume Next
For Each C In Range("A2:A12")
If IsError(Application.Match(C.Value, Ary, 0)) Then
ReDim Preserve Ary(i): Ary(i) = C.Value
i = i + 1
End If
Next
For i = LBound(Ary) To UBound(Ary)
Debug.Print Ary(i)
Next i
Erase Ary
End Sub
イミディエイトウィンドウで確認して下さい。
同様にループ処理で、DictionaryObject を使って
Sub Dic_Test()
Dim dic As Object, Ks As Variant
Dim C As Range
Dim i As Long
Set dic = CreateObject("Scripting.Dictionary")
For Each C In Range("A2:A20")
If dic.Exists(C.Value) = False Then
dic.Add C.Value, i
i = i + 1
End If
Next
Ks = dic.Keys
For i = 0 To dic.Count - 1
Debug.Print Ks(i)
Next i
Set dic = Nothing
End Sub
というコードも考えられま。Ks にユニークな値が格納されます。
|
|
Kein
- 04/9/18(土) 2:27 -
