VBAのDictionaryを活用し、配列を渡して重複を削除して返してくれる関数をご紹介したいと思います。
Dictionaryオブジェクトとは?
Dictionaryとは連想配列とも呼ばれていて、Keyと値をセットで格納するオブジェクトで、一つのDictionaryの中に重複するKeyは保持出来ない特徴を持ちます。
重複する値をDictionaryへ代入しようとするとエラーが吐かれるので、そこを利用してキャッチしてしまおうと言うのが今回の内容になります。
ちなみに連想配列はエクセルVBA以外でもJavaScript、PHP、Python等の言語でも使われています。
コード:DeleteArrayData
下記コードをコピペして頂ければそのまま利用可能です。
VBEの起動の仕方などは下記を参照してください↓
※ Microsoft Scripting Runtimeの参照設定も追加してください。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 |
'****************************************************************** '* 重複削除処理 '****************************************************************** Function DeleteArrayData(arrData As Variant) As Variant() ' Dictionaryオブジェクト宣言 Dim dic As Dictionary Set dic = CreateObject("Scripting.Dictionary") ' 配列カウンタ Dim nCnt As Long ' エラー時は次のループへ On Error Resume Next ' 配列の長さ分(要素数)ループ For nCnt = 0 To UBound(arrData) ' 重複してる場合はエラーが起きるので次のループへスキップされる ' 重複してない場合はdicへ値が追加される dic.Add arrData(nCnt), arrData(nCnt) Next ' 返却値格納 DeleteArrayData = dic.Keys End Function |
参照渡ししても良かったですが変えたくない場合も有ると思うので値渡しにしています。
実際の挙動確認
まずテスト用に下記雑コードを用意。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 |
Sub Test() Dim arrData() As Variant ReDim arrData(5) arrData(0) = 11 arrData(1) = 88 arrData(2) = 11 arrData(3) = 77 arrData(4) = 11 arrData(5) = 90 ' そのまま返却値で上書き arrData = DeleteArrayData(arrData) End Sub |
DeleteArrayDataにブレークを張ってからTest()マクロを実行して、ローカルウィンドウで通過後の変化を見てみましょう。
はい、無事DeleteArrayData通過後には重複していた値が削除されました!
あとがき
配列のカウンタを0から始めてるので、1からスタートの配列とかも併用してここを通したい場合はチェックするルートが必要です。
めちゃめちゃ汎用的なので 個人用マクロブックにでも保存して、ご自身の環境に合わせて使ってみてください~(ᵔᴥᵔ)
コメント