0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 5 years have passed since last update.

エクセルVBAで重複を除いた数を数える

Last updated at Posted at 2019-12-25

はじめに

エクセルで重複を除いたアイテムの個数を数えたい時が結構あります。
連想配列(ディクショナリー)を使って数える方法がよく紹介されていますが、今回もう少し複雑な状況に遭遇したので投稿します。

具体的には、こんな状況です。
image.png

つまり、1つのセルにccc/aaaのように複数のアイテムを"/"で区切ってあって、これを「ccc」と「aaa」と区別した上で重複していないアイテムの個数を数えたいという状況です。

コード

関数として定義します。引数としてセル範囲を指定し、整数を返します。


流れとしては、

  1. 連想配列dictを作成
  2. 引数のセル範囲の各セルに対してループ処理を実行(3~4)
  3. セルの値がdictのキーに存在している場合は、次のセルへ
  4. セルが空白セルでなければ、dictのキーにセルの値を、値に1を追加
  5. 次に、dictの各キーに対してのループ処理を実行(6~)
  6. キーに"/"が含まれていたら、そのキーを"/"で分離して別の変数splitTxtに配列として格納し、このキー自体はdictから削除
  7. splitTxtの中でループ処理を実行(8~9)
  8. 分離した文字列txtがdictのキーに存在している場合は、次のtxtへ
  9. そうでなければtxtをdictのキーに追加し、値は1とする
  10. countNumberの戻り値としてdictの要素数を返す
Function countNumber(rng As Range) As Long

Dim dict As Object

Dim x As Range
Dim keyTxt As String
Dim key, splitTxt, txt As Variant

Set dict = CreateObject("Scripting.Dictionary")

For Each x In rng
    If dict.exists(x.Value) Then
        GoTo continue1
    End If

    If Not IsEmpty(x) Then
        dict.Add x.Value, 1
    End If
continue1:
Next


For Each key In dict
    If key Like "*/*" Then
        keyTxt = key
        splitTxt = Split(keyTxt, "/")
        dict.Remove key
        
        For Each txt In splitTxt
            If dict.exists(txt) Then
                GoTo continue2
            Else
                dict.Add txt, 1
            End If
continue2:
        Next
    End If
Next

countNumber = dict.Count

End Function

簡単に解説

まずVBAで連想配列を使う場合は、変数をオブジェクトとして宣言してCreateObject関数を使う必要があります。

Dim dict As Object

Set dict = CreateObject("Scripting.Dictionary")

次に、連想配列のキーに各セルの値を入れていきます。キーに対する値はなんでも良いので1としました。 さて、引数のセル範囲中の各セルに対して処理を行うためにFor Each文を使います。最初のIf文は、「連想配列dictにすでにキーが存在している場合、continue1まで行ってね。」という処理です。一般的なプログラミング言語では、continue文というのがありますが(ループを1回スキップする)、VBAにはないので、こういう処理にします。 2つ目のIf文は、セルが空白セルでなければdictのキーにセルの値を、値に1を追加する処理です。 これで一通りセルの値を重複することなくdictのキーに追加することができました(そもそも連想配列はキーを重複させられません=>重複させようとするとエラーになります)。
For Each x In rng
    If dict.exists(x.Value) Then
        GoTo continue1
    End If

    If Not IsEmpty(x) Then
        dict.Add x.Value, 1
    End If
continue1:
Next

ここからが今回の大事な部分です。 dict中の各キーに対してループ処理を行います。キーが"/"を含んでいる場合に別の文字列変数keyTxtに格納します。そして、Split関数を使って、"/"で分離した文字列をを要素とする配列をsplitTxtに格納します。このキーは要らないので削除します。

(参考サイト)Split関数の使い方:Split関数で文字列を区切る

次に、配列splitTxt内でループ処理を行います。配列内の各要素がdictの要素として存在していれば、ループをスキップし(先ほどと同様)、そうでなければキーとして加えます。これでdictのキーには、重複のないアイテムが揃ったことになります。


For Each key In dict
    If key Like "*/*" Then
        keyTxt = key
        splitTxt = Split(keyTxt, "/")
        dict.Remove key
        
        For Each txt In splitTxt
            If dict.exists(txt) Then
                GoTo continue2
            Else
                dict.Add txt, 1
            End If
continue2:
        Next
    End If
Next

0
0
4

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?