XL 2016 Compter sans doublons

KTM

XLDnaute Impliqué
Bonjour Cher Forum
Je voudrais compter dans ma base le nombre de références enregistrées sur l'année en excluant les doublons.
J'ai préparé une macro mais il se trouve qu'elle n'est pas parfaite.
Aidez moi à la réussir MERCI
VB:
Sub unique()
Dim un As New Collection
Dim ls As Integer
Dim ind As Integer
Dim annee As Integer
Dim cel As Range

With Sheets("Base")
annee = .[K1]
ls = .Range("A2").End(xlDown).Row
For Each cel In .Range("A3:A" & ls)
ind = Year(CDate(.Range("B" & cel.Row)))
If ind = annee Then
un.Add cel.Value, CStr(cel.Value)
End If
Next cel
.[K3].Value = un.Count
End With
End Sub
 

Pièces jointes

  • IND.xlsm
    18.1 KB · Affichages: 10

cp4

XLDnaute Barbatruc
Bonjour @KTM,

Je t'avoue que je ne maitrise pas du tout les collections. Je n'ai jamais pris le temps pour essayer de les comprendre. Cependant, un message explicite est affiché suite au plantage sur la ligne
VB:
un.Add cel.Value, CStr(cel.Value)
J'ai rajouté une gestion d'erreur classique, vois si le résultat est bon
Code:
Option Explicit

Sub unique()
    Dim un As New Collection, ls As Integer, ind As Integer, annee As Integer, cel As Range
    Dim d As Object
    Set d = CreateObject("scripting.dictionary")
    With Sheets("Base")
        annee = .[K1]
        ls = .Range("A2").End(xlDown).Row
        For Each cel In .Range("A3:A" & ls)
            ind = Year(CDate(.Range("B" & cel.Row)))
            If ind = annee Then
                On Error Resume Next
                un.Add cel.Value, CStr(cel.Value)
                On Error GoTo 0
            End If
        Next cel
        .[K3].Value = un.Count
    End With
End Sub

Bonne journée.
 

KTM

XLDnaute Impliqué
Bonjour @KTM,

Je t'avoue que je ne maitrise pas du tout les collections. Je n'ai jamais pris le temps pour essayer de les comprendre. Cependant, un message explicite est affiché suite au plantage sur la ligne
VB:
un.Add cel.Value, CStr(cel.Value)
J'ai rajouté une gestion d'erreur classique, vois si le résultat est bon
Code:
Option Explicit

Sub unique()
    Dim un As New Collection, ls As Integer, ind As Integer, annee As Integer, cel As Range
    Dim d As Object
    Set d = CreateObject("scripting.dictionary")
    With Sheets("Base")
        annee = .[K1]
        ls = .Range("A2").End(xlDown).Row
        For Each cel In .Range("A3:A" & ls)
            ind = Year(CDate(.Range("B" & cel.Row)))
            If ind = annee Then
                On Error Resume Next
                un.Add cel.Value, CStr(cel.Value)
                On Error GoTo 0
            End If
        Next cel
        .[K3].Value = un.Count
    End With
End Sub

Bonne journée.
Merci Tout fonctionne.
Je peux donc poursuivre.
Encore Merci.
 

job75

XLDnaute Barbatruc
Bonjour KTM, cp4,

Juste pour signaler que le VBA n'est pas indispensable, avec ces formules matricielles en K3 et K4 :
Code:
=NB(LN(EQUIV(A$3:A$13&K$1;A$3:A$13&ANNEE(B$3:B$13);0)=LIGNE(A$3:A$13)-2))
Code:
=NB(LN(EQUIV(A$3:A$13&K$1&MOIS(K$2);A$3:A$13&ANNEE(B$3:B$13)&MOIS(B$3:B$13);0)=LIGNE(A$3:A$13)-2))
A+
 

Pièces jointes

  • Unique(1).xlsx
    10.8 KB · Affichages: 8

KTM

XLDnaute Impliqué
Bonjour KTM, cp4,

Juste pour signaler que le VBA n'est pas indispensable, avec ces formules matricielles en K3 et K4 :
Code:
=NB(LN(EQUIV(A$3:A$13&K$1;A$3:A$13&ANNEE(B$3:B$13);0)=LIGNE(A$3:A$13)-2))
Code:
=NB(LN(EQUIV(A$3:A$13&K$1&MOIS(K$2);A$3:A$13&ANNEE(B$3:B$13)&MOIS(B$3:B$13);0)=LIGNE(A$3:A$13)-2))
A+
Merci Job75 cela pourra me servir.
Dans mon cas j'avais besoins du VBA. Je dois utiliser le résultat dans dans un userform
 

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 943
Membres
101 849
dernier inscrit
florentMIG