Autres filtre et suppression doublons

[julien741]

Bonjour à tous,

J'ai besoin d'un coups de main sur une macro que j'ai crée.
Dans le fichier joint normalement la macro fonctionne bien, elle donne l'exemple de ce que souhaite.
La macro permet de filtre suivant la colonne C (ES ou MA) puis la colonne G ( suivant le numéro 40), elle copie le filtre dans une autre feuille (feuil 2 pour ES et feuil3 pour MA) puis supprime les doublons de la colonne (voir feuil 2 ou 3) et crée sur la colonne suivant le somme du filtre.

Se que souhaite faire et la même chose mais pour chaque numéro de la colonne G de la feuil1 (pour ES et MA de la colonne C)
Voir le fichier joint (sous Excel 2007)

Merci par avance de votre aide.

Cordialement.
Julien.

 

[cp4]

Bonjour,

Je n'ai pas tout compris. Mais voici un début, le code te donne le nombre de valeurs pour etb=ES et cat=0

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

A+

 

[julien741]

Bonjour cp4,

Merci, c'est presque ça.
Au lieu d'avoir un affichage par message, je souhaiterais l'avoir sur la feuil 2 (liste avec suppression des doublons et sur la colonne a coté l'affichage du nombre)

L'idée est d'avoir sur la feuil 2 tous les tries ES avec leurs cat et en feuil 3 les tries MA avec leur Catégorie.
exemple : en feuil 2 en colonne B (le résultat du filtre => trie colonne C =ES puis trie colonne G cat 01) et résultat du nombre en colonne C1 en colonne D (le résultat du filtre => trie colonne C=ES puis trie colonne G cat 06) et le résultat du nombre en E1,...

Merci pour le coups de main.
Cdt.
Julien.

 

[cp4]

Re,

j'ai renommé les feuilles en ES et AM, vu le nombre de données le code est un peu lent. Mais je pense qu'il répond à ta demande.

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

 

[julien741]

Bonjour CP4,

Merci, ta macro fonctionne bien, c'est bien ce que je souhaite, cependant le résultat des données n'est pas juste. si je prend le filtre MA en catégorie 32 c'est égale à 0, et une fois la macro lancé on obtient 541, j'ai remarqué que sur toute les tries que se soit en ES ou MA on retrouve toujours les même nom de client "colonne B" alors que si je filtre dans la feuil1 en premier MA ou ES et après je filtre sur la cat on obtient pas les nom de client même.


Est-ce que tu penses que cela se corrige?

Merci par avance.
Cdt.
Julien.

 

[cp4]

Bonjour CP4,

Merci, ta macro fonctionne bien, c'est bien ce que je souhaite, cependant le résultat des données n'est pas juste. si je prend le filtre MA en catégorie 32 c'est égale à 0, et une fois la macro lancé on obtient 541, j'ai remarqué que sur toute les tries que se soit en ES ou MA on retrouve toujours les même nom de client "colonne B" alors que si je filtre dans la feuil1 en premier MA ou ES et après je filtre sur la cat on obtient pas les nom de client même.


Est-ce que tu penses que cela se corrige?

Merci par avance.
Cdt.
Julien.

Bonjour,

Comme il y a beaucoup de données difficiles de se rendre compte de l'exactitude du résultat.
Je verrai ça plus tard car je suis très chargé cette fin de semaine.

 

[cp4]

Bonjour,

Je n'avais pas bien compris. Ce code à tester

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