【Excel】Unique関数がないバージョンでも使用する方法

はじめに
Unique関数とは
実装
まとめ

はじめに

Excelファイルでよく関数を使用してデータ整理したり調査したりすることが多いと思います。
その中で特に便利な関数を使用しようとした際に、最近実装された関数で今のPCのバージョンでは使用できない関数がちらほらあると思います。

その中でも特に「Unique関数」が特に代表と言ってもいいくらい便利な関数かと思います。

すごく便利なのにバージョンが古くて使用できない。
そして会社の貸与PCなどで簡単にバージョンは上げられない….

そんな悩みを解決方法を紹介していこうと思います。

Unique関数とは

そもそもUnique関数を知らない人向けに簡単に説明をします。

簡単に言うと、UNIQUE関数は重複を除いて一覧を取り出す関数です。

実装

まず、既存の関数を組み合わせるのではなく、VBAで実装していきます。
マクロ有効ファイルにしなければならないため変更方法がわからない方は以下の記事をご参考くだいさい。

以下のコードを標準モジュールに記載しましょう。

Option Explicit

Function UniqueList(rng As Range) As Variant
    Dim dict As Object
    Dim cell As Range
    Dim arr() As Variant
    Dim i As Long
    Dim key As Variant

    Set dict = CreateObject("Scripting.Dictionary")

    ' 重複しない値を追加
    For Each cell In rng
        If Not dict.Exists(CStr(cell.Value)) Then
            dict.Add CStr(cell.Value), cell.Value
        End If
    Next cell

    ' 結果を縦配列に変換
    ReDim arr(1 To dict.Count, 1 To 1)

    i = 1
    For Each key In dict.Keys
        arr(i, 1) = dict(key)
        i = i + 1
    Next key

    UniqueList = arr
End Function

これで完成です。

先ほどの画像でも紹介した果物をA列に記載しました。
次にC列に標準モジュールに搭載した関数を書いていきましょう。

=UniqueList(A1:A10)

はい、そうするとあたかもunique関数が使用できているようになります。

最終行にある「０」はなんなのかというと空白セルを指します。
通常のunique関数がにも表示されますが、いらないと思う場合は以下のコードを紹介します。

Option Explicit

Function UniqueList(rng As Range) As Variant
    Dim dict As Object
    Dim cell As Range
    Dim arr() As Variant
    Dim i As Long
    Dim key As Variant
    
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' 空白を除外しながら重複なしで追加
    For Each cell In rng
        If Trim(CStr(cell.Value)) <> "" Then
            If Not dict.Exists(CStr(cell.Value)) Then
                dict.Add CStr(cell.Value), cell.Value
            End If
        End If
    Next cell
    
    ' データが1件もない場合
    If dict.Count = 0 Then
        UniqueList = ""
        Exit Function
    End If
    
    ' 縦方向の配列にして返す
    ReDim arr(1 To dict.Count, 1 To 1)
    
    i = 1
    For Each key In dict.Keys
        arr(i, 1) = dict(key)
        i = i + 1
    Next key
    
    UniqueList = arr
End Function