Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


11085 / 13644 ツリー ←次へ | 前へ→

【18210】重複なしの抽出(AdvancedFilter) TY 04/9/18(土) 1:11 質問[未読]
【18211】Re:重複なしの抽出(AdvancedFilter) Kein 04/9/18(土) 2:27 回答[未読]

【18210】重複なしの抽出(AdvancedFilter)
質問  TY  - 04/9/18(土) 1:11 -

引用なし
パスワード
   VBAで、
ある列の重複したデータを全てユニークになるように抽出して
さらにソートをかけるには、
.AdvancedFilter
.Sort
メソッドを使えばいいことが分かりましたが、
.AdvancedFilter
で抽出した重複していないデータを配列に1つずつ入れる
方法がわかりません。
どうすれば実現できるのでしょうか?

【18211】Re:重複なしの抽出(AdvancedFilter)
回答  Kein  - 04/9/18(土) 2:27 -

引用なし
パスワード
   "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 にユニークな値が格納されます。

11085 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free