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

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

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

①　サンプルプログラム（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 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

'

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

'
'
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
'