XL 2016 Nombre d'occurrence avec condition

Rabeto

XLDnaute Occasionnel
Bonjour,

Quelqu'un peut m'aider sur ce problématique svp,

Je vous souhaite compter le nombre de véhicule par tranche d'heure, sans compter les doublons, avec un filtre date (ajout d'autre filtre possible, Année, semaine)

merci
 

Pièces jointes

  • Classeur1.xlsx
    96.9 KB · Affichages: 8
Solution
mais je ne saurais le reproduire.
Allons un peu d'effort, comme j'ai dit tout ça est très classique !

Bien sûr les colonnes Année, Mois, Semaine peuvent être supprimées mais c'est moins facile de vérifier :
VB:
For i = 2 To UBound(tablo)
    If Year(tablo(i, 2)) Like an And Month(tablo(i, 2)) Like mois And Application.IsoWeekNum(tablo(i, 2)) Like sem Then
        x = tablo(i, 1) & tablo(i, 3)
        If Not d.exists(x) Then
            n = n + 1
            d(x) = n 'mémorise la ligne
            resu(n, 1) = tablo(i, 1)
            resu(n, 2) = tablo(i, 3)
        End If
        nn = d(x)
        resu(nn, 3) = resu(nn, 3) + 1 'compte
    End If
Next

job75

XLDnaute Barbatruc
Bonjour Rabeto, JHA, M12, chris,

En VBA le filtrage est très classique :
VB:
Private Sub Worksheet_Activate()
Worksheet_Change [A1]
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim an, mois, sem, tablo, resu(), d As Object, i&, x$, n&, nn&
an = [B1]: If an = "" Then an = "*"
mois = [D1]: If mois = "" Then mois = "*"
sem = [F1]: If sem = "" Then sem = "*"
tablo = Sheets("BDD").[A1].CurrentRegion.Resize(, 6) 'matrice, plus rapide
ReDim resu(1 To UBound(tablo), 1 To 3)
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For i = 2 To UBound(tablo)
    If tablo(i, 3) Like an And tablo(i, 4) Like mois And tablo(i, 5) Like sem Then
        x = tablo(i, 1) & tablo(i, 6)
        If Not d.exists(x) Then
            n = n + 1
            d(x) = n 'mémorise la ligne
            resu(n, 1) = tablo(i, 1)
            resu(n, 2) = tablo(i, 6)
        End If
        nn = d(x)
        resu(nn, 3) = resu(nn, 3) + 1 'compte
    End If
Next
'---restitution---
Application.EnableEvents = False 'désactive les évènements
If FilterMode Then ShowAllData
With [A4] '1ère cellule de destination
    If n Then
        .Resize(n, 3) = resu
        .Sort .Columns(1), xlAscending, .Columns(2), , xlAscending, Header:=xlYes
    End If
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 3).ClearContents 'RAZ en dessous
End With
Application.EnableEvents = True 'réactive les évènements
End Sub
A+
 

Pièces jointes

  • Filtre(1).xlsm
    215.5 KB · Affichages: 3

job75

XLDnaute Barbatruc
mais je ne saurais le reproduire.
Allons un peu d'effort, comme j'ai dit tout ça est très classique !

Bien sûr les colonnes Année, Mois, Semaine peuvent être supprimées mais c'est moins facile de vérifier :
VB:
For i = 2 To UBound(tablo)
    If Year(tablo(i, 2)) Like an And Month(tablo(i, 2)) Like mois And Application.IsoWeekNum(tablo(i, 2)) Like sem Then
        x = tablo(i, 1) & tablo(i, 3)
        If Not d.exists(x) Then
            n = n + 1
            d(x) = n 'mémorise la ligne
            resu(n, 1) = tablo(i, 1)
            resu(n, 2) = tablo(i, 3)
        End If
        nn = d(x)
        resu(nn, 3) = resu(nn, 3) + 1 'compte
    End If
Next
 

Pièces jointes

  • Filtre(2).xlsm
    113.6 KB · Affichages: 4

Discussions similaires