Calculer le nombre d'occurence

sum01

XLDnaute Occasionnel
Bonsoir à toutes et à tous,
Toutes la journée j'ai planché sur ce problème sans y trouver de solution. Je voudrais calculer le nombre d'occurence mais en tenant compte qu'une seule fois d'une même donnée.
Admettons que dans mes cellules, j'ai renseigné les données suivantes
2015-035 04 4b
2015-035 04 3a
2015-035 04 6c
2015-035 01 1a
Ma formule imaginée devrait me trouver que 2 occurences, à savoir le rapport 2015-035 et le rapport 2015-01. Autrement dit, le résultat de ma formule doit être 2
J'ai tenté de passer par sommeprod mais sans succès.
Merci d'avance pour votre aide et excellente soirée.
 

Pièces jointes

  • Test1.xlsx
    38.6 KB · Affichages: 16

sum01

XLDnaute Occasionnel
Bonjour Piga25
Merci pour votre réponse. J’essayé cette formule mais sans succès car il aurait fallu que je parvienne à lier le résultat de la formule au rapport. En effet, j ai deux rapports 2015-035 avec un indice 04 et 01. Dans la liste des rapports, j’aurai ensuite 2019-045 01 , 2019-045 01 encore une fois? 2019-045 02, 2019-045 03. Comment écrire la formule afin que celle-ci m’indique que pour le rapport 2019-045 le résultat de la formule doit être 3 car j’ai le rapport 2019-045 avec 3 indices différents ?
Merci encore pour votre aide
 

job75

XLDnaute Barbatruc
Bonjour sum1, piga25, le forum,

"Ce que je recherche à obtenir" n'est pas bien cohérent car vous mélangez les choses à rechercher avec "Haut" et "Moyen".

Si vous voulez calculer les totaux pour chaque colonne vous pouvez utiliser cette macro :
VB:
Sub Total()
Dim dest As Range, nlig&, ncol%, tablo, resu, d As Object, i&, n&, j%, d1 As Object, x$, y&
Application.ScreenUpdating = True
Set dest = [F1] '1ère cellule de destination, à adapter
With [A1].CurrentRegion
    If .Parent.FilterMode Then .Parent.ShowAllData 'si la feuille est filtrée
    nlig = .Rows.Count
    ncol = .Columns.Count
    dest(2).Resize(.Parent.Rows.Count - dest.Row, ncol).ClearContents 'RAZ
    tablo = .Resize(nlig + 1) 'matrice, plus rapide, au moins 2 éléments
End With
ReDim resu(1 To nlig, 1 To ncol)
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For i = 2 To nlig
    If Not d.exists(tablo(i, 1)) Then
        n = n + 1
        resu(n, 1) = tablo(i, 1)
        d(tablo(i, 1)) = n 'mémorisation de la ligne
    End If
Next i
If d.Count = 0 Then Exit Sub
Set d1 = CreateObject("Scripting.Dictionary")
d1.CompareMode = vbTextCompare 'la casse est ignorée
For j = 2 To ncol
    d1.RemoveAll
    For i = 2 To nlig
        x = tablo(i, 1) & Chr(1) & Trim(tablo(i, j))
        If Not d1.exists(x) Then
            d1(x) = ""
            y = d(tablo(i, 1))
            resu(y, j) = resu(y, j) + 1
        End If
Next i, j
dest(2).Resize(n, ncol) = resu
End Sub
PS : j'ai mis un "Trim" car en D5 vous avez mis un espace à la suite de "Moyen"...

A+
 

Pièces jointes

  • Test(1).xlsm
    26.2 KB · Affichages: 12

sum01

XLDnaute Occasionnel
Bonjour Job75 merci infiniment pour cette réponse. Je vais tester / adapter ce code à mon fichier de travail. Je vous reviendrai à d'autres questions le cas échéant. Encore merci vous deux pour vos réponses et implications dans ce projet. Je vous souhaite un bon dimanche.
 

Discussions similaires