配列をユニーク（一意）にする - Unique Array

はじめに - Introduction

Ruby の uniq 的なメソッドが VBA には無いので、作りました。
VBA hasn't method like uniq of Ruby, so I implemented.

実装 - Implementation

' ===== Outline
' Unify Array elements.
'
' ===== Argument
' aryTarget: Array, you'd like to unify.
'
' ===== Return Value
' Unique Array.
' If number of elements of Array is 0, then return Null.
'
' ===== Author
' bekkou68
Private Function UniqueArray(ByVal aryTarget As Variant) As Variant
    Dim varItem As Variant          ' Element of aryTarget.
    Dim colUnique As Collection     ' Unique collection.
    Dim aryUnique As Variant        ' Unique array.
    
    ' Extract unique value from target to Collection.
    Set colUnique = New Collection
    On Error Resume Next
    For Each varItem In aryTarget
        colUnique.Add varItem, varItem
    Next
    On Error GoTo 0
    
    UniqueArray = CollectionToArray(colUnique)
    Set colUnique = Nothing
End Function

' ===== Outline
' Convert Collection into Array.
'
' ===== Argument
' colTarget: Collection, you'd like to convert into Array.
'
' ===== Return Value
' Array converted from Collection.
' If size of Collection is 0, then return Null.
'
' ===== Author
' bekkou68
Private Function CollectionToArray(ByVal colTarget As Collection) As Variant
    Dim aryConverted() As Variant
    Dim intCounter As Integer
    
    If colTarget.Count <> 0 Then
        ReDim aryConverted(colTarget.Count - 1)
        
        For intCounter = 1 To colTarget.Count
            aryConverted(intCounter - 1) = colTarget(intCounter) ' First index of Collection is 1.
        Next
        
        CollectionToArray = aryConverted
    Else
        CollectionToArray = Null
    End If
End Function

テスト - Test

Option Explicit

Public Sub TestUniqueArray()
    Debug.Print "- - - - -"
    ShowCommaJoinedArray (UniqueArray(Array("a", "a", "b", "c", "b", "a")))
    Debug.Print "- - - - -"
    ShowCommaJoinedArray (UniqueArray(Array()))
    Debug.Print "- - - - -"
End Sub

' ===== Outline
' Show comma-joined elements of Array to immediate window.
' If number of elements of Array is 0, then show "It is Null!".
'
' ===== Argument
' aryTarget: Array, you'd like to show.
'
' ===== Author
' bekkou68
Private Sub ShowCommaJoinedArray(ByVal aryTarget As Variant)
    If IsNull(aryTarget) Then
        Debug.Print "It is Null!"
    Else
        Debug.Print Join(aryTarget, ",")
    End If
End Sub

' ===== Outline
' Unify Array elements.
'
' ===== Argument
' aryTarget: Array, you'd like to unify.
'
' ===== Return Value
' Unique Array.
' If number of elements of Array is 0, then return Null.
'
' ===== Author
' bekkou68
Private Function UniqueArray(ByVal aryTarget As Variant) As Variant
    Dim varItem As Variant          ' Element of aryTarget.
    Dim colUnique As Collection     ' Unique collection.
    Dim aryUnique As Variant        ' Unique array.
    
    ' Extract unique value from target to Collection.
    Set colUnique = New Collection
    On Error Resume Next
    For Each varItem In aryTarget
        colUnique.Add varItem, varItem
    Next
    On Error GoTo 0
    
    UniqueArray = CollectionToArray(colUnique)
    Set colUnique = Nothing
End Function

' ===== Outline
' Convert Collection into Array.
'
' ===== Argument
' colTarget: Collection, you'd like to convert into Array.
'
' ===== Return Value
' Array converted from Collection.
' If size of Collection is 0, then return Null.
'
' ===== Author
' bekkou68
Private Function CollectionToArray(ByVal colTarget As Collection) As Variant
    Dim aryConverted() As Variant
    Dim intCounter As Integer
    
    If colTarget.Count <> 0 Then
        ReDim aryConverted(colTarget.Count - 1)
        
        For intCounter = 1 To colTarget.Count
            aryConverted(intCounter - 1) = colTarget(intCounter) ' First index of Collection is 1.
        Next
        
        CollectionToArray = aryConverted
    Else
        CollectionToArray = Null
    End If
End Function

以下、イミディエイトウィンドウの出力。
The following is an output of immediate window.

- - - - -
a,b,c
- - - - -
It is Null!
- - - - -