Filtre élaboré sans doublon sauf exception

[cheyenne63]

Bonjour
Dans le fichier joint :
Dans « BD », ben la base de données
Dans « Filtre » le résultat du filtre sur la date (que l’on indique en I2 sur la feuille « BD »)
Dans « Skejveux », le résultat attendu pour un filtre sur le 02 décembre
Quelques explications :
En fait, dans « BD », certains prénoms ont sur la même ligne un X dans la colonne D.
Ce X signifie :
1. Dans le filtre je ne veux pas voir ces prénoms en doublons (mais les autres si)
2. Dans la colonne E du résultat (du filtre) je souhaiterai qu’apparaisse la somme des Nbr de la BD concernant ces prénoms associés à un X

C’est vraiment pas facile d’être toujours claire…
Merci d’avance

 

[job75]

Re : Filtre élaboré sans doublon sauf exception

Rebonjour cheyenne63,

La macro dans le code de la feuille "BD" :

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [I2]) Is Nothing Then Exit Sub
Dim dat, tablo, d As Object, i&, n&, j%
dat = [I2]
tablo = Range("A2:E" & Range("A" & Rows.Count).End(xlUp).Row)
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(tablo)
  If tablo(i, 1) = dat Then
    If tablo(i, 4) = "" Then
      n = n + 1
      For j = 1 To 5
        tablo(n, j) = tablo(i, j)
      Next
    Else
      If d.Exists(tablo(i, 3)) Then
        tablo(d(tablo(i, 3)), 5) = tablo(d(tablo(i, 3)), 5) + tablo(i, 5)
      Else
        n = n + 1
        d(tablo(i, 3)) = n
        For j = 1 To 5
          tablo(n, j) = tablo(i, j)
        Next
      End If
    End If
  End If
Next
With Sheets("Filtre")
  If n Then .[A2].Resize(n, 5) = tablo
  .Range("A" & n + 2 & ":E" & .Rows.Count).Delete xlUp
  If dat <> "" Then .Activate
End With
End Sub

Elle s'exécute quand on modifie la cellule I2.

Elle est très rapide même sur de très grands tableaux car elle utilise le tableau VBA tablo.

Et bien sûr l'objet "Dictionary" qui élimine les doublons..

Fichier joint.

A+

 

[job75]

Re : Filtre élaboré sans doublon sauf exception

Re,

Avec un tableau de 50000 lignes (tableau actuel copié 2500 fois) la durée d'exécution est de 0,92 s.

Sur Win XP - Excel 2003.

A+

 

[cheyenne63]

Re : Filtre élaboré sans doublon sauf exception

Merci
C'est super.
Je teste sur mon fichier dans la matinée.
Encore bravo ... et merci

 

[cheyenne63]

Re : Filtre élaboré sans doublon sauf exception

Bonjour
J'ai beau essayer, je n' arrive pas à améliorer le fichier ...
Comment faire pour inclure comme 2° critère une date de fin.
Donc une période, de telle date à telle date ... avec les mêmes fonctionnalités que job75 a fait dans le dernier fichier
Merci d'avance

 

[job75]

Re : Filtre élaboré sans doublon sauf exception

Bonjour cheyenne63,

J'ai beau essayer, je n' arrive pas à améliorer le fichier ...
Comment faire pour inclure comme 2° critère une date de fin.

Ce n'est pourtant pas bien compliqué d'adapter 🙄

En I2 la date de début, en J2 la date de fin, puis :

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [I2,J2]) Is Nothing Then Exit Sub
Dim dat1, dat2, tablo, d As Object, i&, n&, j%
dat1 = [I2]: dat2 = [J2]
tablo = Range("A2:E" & Range("A" & Rows.Count).End(xlUp).Row)
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(tablo)
  If tablo(i, 1) >= dat1 And tablo(i, 1) <= dat2 Then
    If tablo(i, 4) = "" Then
      n = n + 1
      For j = 1 To 5
        tablo(n, j) = tablo(i, j)
      Next
    Else
      If d.Exists(tablo(i, 3)) Then
        tablo(d(tablo(i, 3)), 5) = tablo(d(tablo(i, 3)), 5) + tablo(i, 5)
      Else
        n = n + 1
        d(tablo(i, 3)) = n
        For j = 1 To 5
          tablo(n, j) = tablo(i, j)
        Next
      End If
    End If
  End If
Next
With Sheets("Filtre")
  If n Then .[A2].Resize(n, 5) = tablo
  .Range("A" & n + 2 & ":E" & .Rows.Count).Delete xlUp
  If dat2 <> "" Then .Activate
End With
End Sub

A+

 

[cheyenne63]

Re : Filtre élaboré sans doublon sauf exception

Bonjour
Impeccable. Merci beaucoup et bonne journée

 

[cheyenne63]

Re : Filtre élaboré sans doublon sauf exception

Bon dans le même style.
J'ai rajouté une colonne (F) et adapté (je sais c'était facile) la macro pour que le "filtre" la prenne en compte.
Mais je voudrai qu'un troisième critère se fasse d'après les valeurs de cette colonne.
La somme (colonne E) se ferai donc d'après les critères du premier post (rappel : si "x" dans colonne D) et maintenant en plus, si valeur identique en colonne F.
J'espère avoir été claire.
Merci d'avance

 

[job75]

Re : Filtre élaboré sans doublon sauf exception

Bonjour cheyenne63,

Ci-joint votre fichier avec la macro corrigée.

Il suffisait de concaténer les 2 critères, colonne C et colonne F.

NB : les boucles j (colonnes) doivent aller jusqu'à 6...

A+