XL 2016 Compter sans doublons

[KTM]

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

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

 

[cp4]

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

un.Add cel.Value, CStr(cel.Value)

J'ai rajouté une gestion d'erreur classique, vois si le résultat est bon

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]

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

un.Add cel.Value, CStr(cel.Value)

J'ai rajouté une gestion d'erreur classique, vois si le résultat est bon

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.

 

[cp4]

Merci Tout fonctionne.
Je peux donc poursuivre.
Encore Merci.

Merci de pointer la solution pour faciliter la recherche aux autres membres.
Bonne journée.😎

 

[job75]

Bonjour KTM, cp4,

Juste pour signaler que le VBA n'est pas indispensable, avec ces formules matricielles en K3 et K4 :

=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))

=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+

 

[KTM]

Bonjour KTM, cp4,

Juste pour signaler que le VBA n'est pas indispensable, avec ces formules matricielles en K3 et K4 :

=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))

=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