EXCEL VBA 重複しているデータの件数をカウントする（Countif・SubTotal・配列）テクニック

2022年8月24日

EXCEL VBA 重複しているデータの件数をカウントする（Countif・SubTotal・配列）テクニック

●はじめに

今回説明するのは、登録されているデータの中から重複しているデータの件数をカウントするサンプルプログラムの紹介をいたします。重複しているデータをカウントする方法としてCountifとSubTotal・配列の３つの方法でサンプルプログラムを作成しました。大量のデータの中から検索データを指定して重複の件数を調べるのに便利だと思います。また、単独・複数条件にも対応していますので、詳細につきましては、サンプルプログラムを交えて順番に説明いたします。

●【EXCEL VBA 重複データをチェック・抽出・別シート・メッセージ・New Collection（テクニック）については、下記を参照して下さい】

EXCEL VBA 重複データをチェック・抽出・別シート・メッセージ・New Collection（テクニック）

●【EXCEL VBA 重複データを削除・チェック・抽出・別シート（RemoveDuplicates メソッド）)については、下記を参照して下さい】

EXCEL VBA 重複データを削除・チェック・抽出・別シート（RemoveDuplicates メソッド）

EXCEL VBA 重複しているデータの件数をカウントする（Countif・フィルター）テクニック①②

●プログラム説明（サンプル①②）

下記のサンプルプログラムは、重複しているデータの件数をカウントするサンプルプログラムとなります。大量にデータが有る場合に重複データの件数を求める際に便利だと思います。それでは、サンプルプログラムを交えて順番に説明いたします。

【サンプルプログラム①の流れ】

①　D列の最終行を取得します。
②　D列の2行目からD列の最終行まで繰り返します。
③　Countif関数でD列の指定した支店名とA列の支店名から一致する件数を取得します。
④　D列の支店と一致する件数が1を超える場合は重複として判定します。
⑤　重複件数が１を超える場合は、”●件重複”と該当するE列に表示します。
⑥　重複件数が１以下の場合は、重複していないので、”重複なし”と該当するE列に表示します。

【サンプルプログラム②の流れ】
①　D列の最終行を取得します。
②　D列に登録されている支店名を上から順番にA列にフィルターを掛けます。
③　A列にフィルターが掛けられている件数を把握します。（フィルターの件数は、見出し部分もカウントされる。＋１件）
④　D列の支店名でA列をフィルターを掛けた時に、2件を超えた場合は、重複と判定します。
⑤　重複件数が２を超えた場合は、”●件重複”と該当するE列に表示します。
⑥　重複件数が２以下の場合は、”重複なし”　（見出し部分1件と支店名1件　計2件とカウントするため、実際に支店名として1件となる
⑦　A列のフィルターを解除します。

①　サンプルプログラム（Countifの場合）

'
'
Sub Countuf01()   '重複している個数をカウント　（Countif）
    
    Dim Cnt, I, lRow As Long
    
    lRow = Cells(Rows.Count, "D").End(xlUp).Row  'D列の最終行を取得します。
    
    
    For I = 2 To lRow  'D列の2行目からD列の最終行まで繰り返します。
    
        Cnt = WorksheetFunction.CountIf(Range("A:A"), Cells(I, "D")) 'Countif関数でD列の指定した支店名とA列の支店名から一致する件数を取得します。
    
        If Cnt > 1 Then '件数が1を超える場合は重複として判定します。
                Cells(I, "E") = Cnt - 1 & "件重複"
            Else
                Cells(I, "E") = "重複なし"
        End If
        
    Next I
    
    
End Sub
'

Sub Countuf01() '重複している個数をカウント　（Countif）

Dim Cnt, I, lRow As Long

lRow = Cells(Rows.Count, "D").End(xlUp).Row 'D列の最終行を取得します。

For I = 2 To lRow 'D列の2行目からD列の最終行まで繰り返します。

Cnt = WorksheetFunction.CountIf(Range("A:A"), Cells(I, "D")) 'Countif関数でD列の指定した支店名とA列の支店名から一致する件数を取得します。

If Cnt > 1 Then '件数が1を超える場合は重複として判定します。

Cells(I, "E") = Cnt - 1 & "件重複"

Else

Cells(I, "E") = "重複なし"

End If

Next I

End Sub

②　サンプルプログラム（フィルターの場合）

'
'
Sub Countuf02()   '重複している個数をカウント　（フィルター）
    
    Dim Cnt, I, lRow As Long
    
    lRow = Cells(Rows.Count, "D").End(xlUp).Row  'D列の最終行を取得します。
    
    For I = 2 To lRow
    
        Range("A1").AutoFilter 1, Cells(I, "D")  'D列の順番にフィルターを掛けます。
        Cnt = WorksheetFunction.Subtotal(3, Range("A:A")) 'フィルダーで抽出されている件数
        
        If Cnt > 2 Then  '件数が２を超える場合は重複として判定します。
                Cells(I, "E") = Cnt - 2 & "件重複"
            Else
                Cells(I, "E") = "重複なし"
        End If
        
    Next I
    
    Range("A1").AutoFilter  'フィルターを解除します。
    
    
End Sub

'

Sub Countuf02() '重複している個数をカウント　（フィルター）

Dim Cnt, I, lRow As Long

lRow = Cells(Rows.Count, "D").End(xlUp).Row 'D列の最終行を取得します。

For I = 2 To lRow

Range("A1").AutoFilter 1, Cells(I, "D") 'D列の順番にフィルターを掛けます。

Cnt = WorksheetFunction.Subtotal(3, Range("A:A")) 'フィルダーで抽出されている件数

If Cnt > 2 Then '件数が２を超える場合は重複として判定します。

Cells(I, "E") = Cnt - 2 & "件重複"

Else

Cells(I, "E") = "重複なし"

End If

Next I

Range("A1").AutoFilter 'フィルターを解除します。

End Sub

●実行前～実行後　※プログラム実行後、D列の支店名を元にA列に登録されている支店名の重複件数を把握する事が出来ました。サンプルプログラム②では。普通に実行すると早くて気づきませんが、実行中にD列の支店名ごとにフィルター処理（A列）が実行されています。
（画面クリックして拡大）

【サンプルプログラム①】の場合

【サンプルプログラム②】の場合

EXCEL VBA 複数重複しているデータの件数をカウントする（配列）テクニック

●プログラム説明（サンプル③）

下記のサンプルプログラムは、サンプルプログラム①②同様に重複しているデータ件数をカウントするサンプルプログラムですが、今回は、複数列にも対応するプログラムとなっております。サンプルプログラムでは、2列を対象としていますが、応用していただければ2列以上も対応する事ができます。重複している条件が複数件有る場合などに利用すると便利だと思います。それでは、サンプルプログラムを交えて順番に説明いたします。

【サンプルプログラム③の流れ】

①　D列の最終行を取得します。
②　セルA列・B列の値を配列に取り込みます。「Dtemp」にA列「支店名」・B列「担当者」のデータを配列データとして取り込む。
③　取り込んだ配列「Dtemp」データの２番目から最後のデータまで繰り返します。
④　配列データの１列目「支店名」と2列目「担当者」を結合します。結合したデータは、配列データ1列目に置き換えます。③配列データの最後のデータまで繰り返す③へ
⑤　D列の検索データ分、2行目から最後のデータまで繰り返します。
⑥　重複検索対象のD列「支店名」とE列「担当者」を「Srh」に代入してデータ結合します。（1つの文字列として検索しやすくするため）
⑦　重複のカウント数を０にします。
⑧　配列「Dtemp」のデータの2番目から最後まで繰り返します。
⑨　重複検索対象のデータと配列結合（支店名＋担当者）で一致件数をカウントします。
⑩　一致したカウント数が１を超える場合は、重複として判定される。
⑪　重複件数が１を超える場合は、”●件重複”と該当するE列に記入されます。
⑫　重複データが無い場合は、「重複なし」と該当するF列に記入されます。
⑬　D列のデータが最終行まで繰り返します。⑧へ

'
'
Sub Countuf03()     '複数の列で重複しているデータ個数をカウント（配列）
    
    Dim Cnt, I, L, lRow As Long
    Dim Srh As String
    Dim Dtemp() As Variant

    
    lRow = Cells(Rows.Count, "D").End(xlUp).Row  'D列の最終行を取得します。
    
    Dtemp = Cells(1, "A").CurrentRegion.Value  'セルA列・B列の値を配列に取込みます。
    
    For I = 2 To UBound(Dtemp)  '取り込んた配列データの2番目から最後までの繰り返します。
        Dtemp(I, 1) = Dtemp(I, 1) + Dtemp(I, 2)  '配列データの「支店名」と「担当者」を結合します。
    Next I
    
    
    For I = 2 To lRow  'D列の2行目から最終行まで繰り返します。
        
        Srh = Cells(I, "D") & Cells(I, "E")  '重複検索対象のD列「支店名」とE列「担当者」を結合します。
        
        Cnt = 0  'カウントを0にする。
        
        For L = 2 To UBound(Dtemp)  '配列のデータの2番目から最後まで繰り返します。
            If Dtemp(L, 1) = Srh Then Cnt = Cnt + 1  '重複検索対象のデータと配列結合（支店名＋担当者」で一致件数をカウントします。
        Next
        
        If Cnt > 1 Then  'カウント数が１を超える場合は、重複として判断される。
                Cells(I, "F") = Cnt - 1 & "件重複"  '重複件数を該当するF列に記入
            Else
                Cells(I, "F") = "重複なし"  '重複データが無い場合は、「重複なし」と該当するF列に記入
        End If
        
    Next I
    
    
End Sub
'