VBA 重複リストをユニークリストに変換

配列(重複リスト)→配列(ユニークリスト)

例(A,A,A,B,B,C)の配列のから(A,B,C)の配列を返す

Sub SAMPLE_rUniqueArr()
'rUniqueArrの呼び出しサンプル
  Dim arrList, uniqueArr, keyName
  arrList = Array("a", "a", "a", "b", "b", "c")
  uniqueArr = rUniqueArr(arrList)
  Dim arr
  For Each arr In uniqueArr
    Debug.Print arr
  Next
End Sub

Function rUniqueArr(arrList As Variant) As Variant
'配列(重複リスト)を渡して配列(ユニークリスト)を返す
'例(A,A,A,B,B,C)の配列の場合(A,B,C)を返す

  'Dictionaryオブジェクトの宣言
  Dim myDic As Object
  Set myDic = CreateObject("Scripting.Dictionary")
  Dim arrTmp, keyName

  'ユニークリストを作成し、itemに各keyの数量を持たせる
  For Each arrTmp In arrList
    keyName = arrTmp
    If Not myDic.Exists(keyName) Then
      myDic.Add keyName, 1
    Else
      myDic.item(keyName) = CInt(myDic(keyName)) + 1
    End If
  Next

  '辞書型.Keys:Keyを配列に格納
  rUniqueArr = myDic.Keys

End Function

配列(重複リスト)→辞書(key：数量)

例(A,A,A,B,B,C)の配列から、{"A":3,"B":2,"C":1}の辞書型を返す

Option Explicit

Sub SAMPLE_rUniqueDic()
'rUniqueDicの呼び出しサンプル
  
  'Dictionaryオブジェクトの宣言
  Dim myDic As Object
  Set myDic = CreateObject("Scripting.Dictionary")

  'rUniqueDicに渡す配列を定義
  Dim arrList, dicList As Object, keyName
  arrList = Array("a", "a", "a", "b", "b", "c")
  Set dicList = rUniqueDic(arrList)
  
  'Keysプロパティで辞書型のkeyを配列に格納する
  'dicList(辞書型)をKeyで周回する
  For Each keyName In dicList.Keys
    Debug.Print keyName & ":" & dicList(keyName)
  Next

End Sub

Function rUniqueDic(arrList As Variant) As Object
'配列を渡してkey(配列のユニークリスト):item(keyの数量)の辞書型で戻す
'例(A,A,A,B,B,C)の配列の場合、{"A":3,"B":2,"C":1}を返す
  'Dictionaryオブジェクトの宣言
  Dim myDic As Object
  Set myDic = CreateObject("Scripting.Dictionary")
  
  Dim arrTmp, keyName
  'ユニークリストを作成し、itemに各keyの数量を持たせる
  For Each arrTmp In arrList
    keyName = arrTmp
    If Not myDic.Exists(keyName) Then
      myDic.Add keyName, 1
    Else
      myDic.item(keyName) = CInt(myDic(keyName)) + 1
    End If
  Next
  
  Set rUniqueDic = myDic

End Function