Allons un peu d'effort, comme j'ai dit tout ça est très classique !mais je ne saurais le reproduire.
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
J'ai mis le lien qui explique comment on fait...Dans le TCD, comment vous avez fait pour insérer le Total Distinct dans le paramètre champ de valeur ?
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
Allons un peu d'effort, comme j'ai dit tout ça est très classique !mais je ne saurais le reproduire.
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