VBAで配列から重複している要素を削除する

VBAで配列から重複している要素を削除するには
Dictionaryオブジェクトを使用します。

Dictionaryオブジェクトを使用するためには
Microsoft Scripting Runtimeに参照設定を行う必要があります。
参照設定の方法についてはこちらをご覧ください。

VBAに標準で含まれていない機能があるときは外部のライブラリを参照して、外部ライブラリ内の機能を利用します。この外部ライブラリの機能を利用する設定を、参照設定と言います。

配列から重複を削除するコードは以下になります。

Function DeleteDuplicateItem(ary() As Variant) As Variant()
'###################################################################################
'配列から重複している要素を削除する
'Dictionaryを使用するので、Microsoft Scripting Runtimeの参照設定が必要
'-----------------------------------------------------------------------------------
'引数  :ary  重複を削除したい配列
'###################################################################################

  Dim dic As New Dictionary
  Dim i As Long
  
  For i = 0 To UBound(ary)
    If dic.Exists(ary(i)) = False Then
      dic.Add ary(i), ary(i)
    End If
  Next i
     
  DeleteDuplicateItem = dic.Keys
  
  Set dic = Nothing
  
End Function

Function DeleteDuplicateItem(ary() As Variant) As Variant()

'###################################################################################

'配列から重複している要素を削除する

'Dictionaryを使用するので、Microsoft Scripting Runtimeの参照設定が必要

'-----------------------------------------------------------------------------------

'引数 :ary 重複を削除したい配列

'###################################################################################

Dim dic As New Dictionary

Dim i As Long

For i = 0 To UBound(ary)

If dic.Exists(ary(i)) = False Then

dic.Add ary(i), ary(i)

End If

Next i

DeleteDuplicateItem = dic.Keys

Set dic = Nothing

End Function

  For i = 0 To UBound(ary)
    If dic.Exists(ary(i)) = False Then
      dic.Add ary(i), ary(i)
    End If
  Next i

For i = 0 To UBound(ary)

If dic.Exists(ary(i)) = False Then

dic.Add ary(i), ary(i)

End If

Next i

配列の要素をDictionaryオブジェクトに格納します。
Existsメソッドを使用し、格納されてない配列要素だけを
Dictionaryに格納します。

DeleteDuplicateItem = dic.Keys

28	DeleteDuplicateItem = dic.Keys

dic.keysで重複した要素を排除した配列を返します

TestDeleteDuplicateItemでDeleteDuplicateItemのテストをしてみます。
配列aryの”テスト1″という項目が重複しています。

Sub TestDeleteDuplicateItem()

  Dim ary(3) As Variant
  ary(0) = "テスト1"
  ary(1) = "テスト2"
  ary(2) = "テスト1"
  ary(3) = "テスト3"
  
  Dim ary2() As Variant
  ary2 = DeleteDuplicateItem(ary)
  
  Dim i As Long
  Dim s As String
  s = ""
  For i = 0 To UBound(ary2)
    s = s & ary2(i) & vbNewLine
  Next i
  MsgBox s
  
End Sub

Sub TestDeleteDuplicateItem()

Dim ary(3) As Variant

ary(0) = "テスト1"

ary(1) = "テスト2"

ary(2) = "テスト1"

ary(3) = "テスト3"

Dim ary2() As Variant

ary2 = DeleteDuplicateItem(ary)

Dim i As Long

Dim s As String

s = ""

For i = 0 To UBound(ary2)

s = s & ary2(i) & vbNewLine

Next i

MsgBox s

End Sub

コードを動かすと配列の重複要素を削除した内容をメッセージボックスに表示します。

吉川　真一より:

2019/11/12(火) 8:07 AM

「deleteDuplicateItem」関数ですが無駄が多いと思います。多分以下のコードで問題ないと思いますがいかがでしょうか？

Function deleteDuplicateItem(ary() As Variant) As Variant()
‘#####################################################################
‘配列から重複している要素を削除する
‘Dictionaryを使用するので、Microsoft Scripting Runtimeの参照設定が必要
‘———————————————————————
‘引数　:ary　重複を削除したい配列
‘#####################################################################

　Dim Dic As Dictionary
　Set Dic = New Dictionary
　
　Dim i As Long
　
　For i = 0 To UBound(ary)
　　If Dic.Exists(ary(i)) = False Then
　　　Dic.Add ary(i), ary(i)
　　End If
　Next i
　　
　deleteDuplicateItem = Dic.Keys()
　
　Set Dic = Nothing
　
End Function

返信

かずさプログラマーより:

2019/11/16(土) 1:04 PM

吉川　真一さん

コメントありがとうございます。
ご指摘のとおり、dictionaryのkeysで配列をそのまま返したほうが、すっきりしますね。
参考にさせていただきます。

返信

吉川　真一より:

2019/11/12(火) 8:07 AM

「deleteDuplicateItem」関数ですが無駄が多いと思います。多分以下のコードで問題ないと思いますがいかがでしょうか？

Function deleteDuplicateItem(ary() As Variant) As Variant()
‘#####################################################################
‘配列から重複している要素を削除する
‘Dictionaryを使用するので、Microsoft Scripting Runtimeの参照設定が必要
‘———————————————————————
‘引数　:ary　重複を削除したい配列
‘#####################################################################

　Dim Dic As Dictionary
　Set Dic = New Dictionary
　
　Dim i As Long
　
　For i = 0 To UBound(ary)
　　If Dic.Exists(ary(i)) = False Then
　　　Dic.Add ary(i), ary(i)
　　End If
　Next i
　　
　deleteDuplicateItem = Dic.Keys()
　
　Set Dic = Nothing
　
End Function

返信
- かずさプログラマーより:
  
  2019/11/16(土) 1:04 PM
  
  吉川　真一さん
  
  コメントありがとうございます。
  ご指摘のとおり、dictionaryのkeysで配列をそのまま返したほうが、すっきりしますね。
  参考にさせていただきます。
  
  返信