Autres filtre et suppression doublons

Option Explicit

Sub compter_sans_doublons()
   Dim d As Object, tb(), i As Long
   Dim d_etb As Object, d_cat As Object

   Set d = CreateObject("scripting.dictionary")
   'Set d_etb = CreateObject("scripting.dictionary")
   'Set d_cat = CreateObject("scripting.dictionary")

   tb = [Tableau_test_elior].Value
   For i = LBound(tb) To UBound(tb)
      If tb(i, 3) = "ES" And tb(i, 7) = 40 Then d(tb(i, 2)) = ""
   Next i
   MsgBox "Le nombre de valeurs pour etb=ES et cat=0 est: " & d.Count
End Sub

Option Explicit

Sub compter_sans_doublons()
   Dim d As Object, tb(), i As Long, j As Long, k As Long
   Dim d_etb As Object, d_cat As Object

   Application.ScreenUpdating = False
   Set d = CreateObject("scripting.dictionary")
   Set d_etb = CreateObject("scripting.dictionary")
   Set d_cat = CreateObject("scripting.dictionary")
   'on met toute la bd dans un tableau
   tb = [Tableau_test_elior].Value

   For i = LBound(tb) To UBound(tb)
      d_etb(tb(i, 3)) = ""   'on récupère dans un dictionnaire sans doublons la colonne 3
      d_cat(tb(i, 7)) = ""   'on récupère dans un dictionnaire sans doublons la colonne 7
   Next i

   If d_etb.Count > 0 Then   'si au moins un item etb dans le dictionnaire
      For i = 0 To d_etb.Count - 1   'boucle sur le nombre d'items etb
         With Sheets(d_etb.keys()(i))   'avec feuille concernèe
            .Cells.ClearContents   'on vide la feuille
            If d_cat.Count > 0 Then   'si au moins un item cat dans le dictionnaire
               For j = 0 To d_cat.Count - 1   'boucle sur le nombre d'items cat
                  For k = 1 To UBound(tb)   ''boucle sur les lignes de tb
                     'conditions pour récupèrer dans un dictionnaire suivant critères les clients sans doublons
                     If tb(k, 3) = d_etb.keys()(i) And tb(k, 7) = d_cat.keys()(j) Then d(tb(k, 2)) = ""
                  Next k
                  'report du résultat sur la feuille concernée
                  .Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).Resize(d.Count) = Application.Transpose(d.keys)
                  .Cells(1, Columns.Count).End(xlToLeft).Offset(, 1) = d.Count
                  .Cells(1, Columns.Count).End(xlToLeft).Offset(1, 0) = "cat=" & d_cat.keys()(j)
               Next j
            End If
         End With
      Next i
   End If
   Application.ScreenUpdating = True

   MsgBox "Traitement terminé!", vbInformation + vbOKOnly, "Succès"
   Set d = Nothing
   Set d_etb = Nothing
   Set d_cat = Nothing
End Sub

Option Explicit

Sub compter_sans_doublons()
   Dim d As Object, d_etb As Object, dcat As Object
   Dim tb(), i As Long, j As Long, cel As Range

   Application.ScreenUpdating = False
   Set d = CreateObject("scripting.dictionary")
   Set d_etb = CreateObject("scripting.dictionary")
   Set dcat = CreateObject("scripting.dictionary")
   'on met toute la bd dans un tableau
   tb = [Tableau_test_elior].Value

   For i = LBound(tb) To UBound(tb)
      d_etb(tb(i, 3)) = ""   'on récupère dans un dictionnaire sans doublons la colonne 3
   Next i

   If d_etb.Count > 0 Then

      For i = 0 To d_etb.Count - 1
         With Sheets(d_etb.keys()(i))   'avec feuille concernèe
            .Cells.ClearContents   'on vide la feuille
            Range("Tableau_test_elior").ListObject.Range.AutoFilter field:=3, Criteria1:=d_etb.keys()(i)   'filtre col3

            For Each cel In Range("Tableau_test_elior[cat]").SpecialCells(xlCellTypeVisible)
               dcat(cel.Value) = ""   'récupération etb sans doublons
            Next cel

            If dcat.Count > 0 Then
               For j = 0 To dcat.Count - 1
                  Range("Tableau_test_elior").ListObject.Range.AutoFilter field:=7, Criteria1:=dcat.keys()(j)   'filtre col7

                  For Each cel In Range("Tableau_test_elior[client]").SpecialCells(xlCellTypeVisible)
                     d(cel.Value) = ""   'récupération cat sans doublons
                  Next cel

                  'report du résultat sur la feuille concernée
                  .Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).Resize(d.Count) = Application.Transpose(d.keys)
                  .Cells(1, Columns.Count).End(xlToLeft).Offset(, 1) = d.Count
                  .Cells(1, Columns.Count).End(xlToLeft).Offset(1, 0) = "cat=" & dcat.keys()(j)
                  d.RemoveAll   'on vide le dictionnaire client
               Next j
            End If
         End With
        
         dcat.RemoveAll   'on vide le dictionnaire cat

         Feuil1.ListObjects("Tableau_test_elior").Range.AutoFilter field:=7   'filtre cat off
      Next i

      Range("Tableau_test_elior").ListObject.AutoFilter.ShowAllData   'affichage toutes les données

   End If
   Application.ScreenUpdating = True

   MsgBox "Traitement terminé!", vbInformation + vbOKOnly, "Succès"
   Set d = Nothing
   Set d_etb = Nothing
   Set dcat = Nothing
End Sub