Soyez le premier à donner votre avis sur cette source.
Vue 17 124 fois - Téléchargée 806 fois
Public Function NbVal_Distinct_Visible(oRange As Range) ' ---------------------------------------------------------------------------- ' Nouvelle fonction Excel par BILLOT Michel ' Compte les valeurs Distintes et visibles sur la Plage oRange ' Cette fonction mise dans la formule de chaque colonne header d'un filtre ' permet de suivre l'évolution du nombre d'entités distinctes résultant du ' filtrage utilisateur sur les colonnes de ActiveSheet.AutoFilter.Range ' ---------------------------------------------------------------------------- ' Idem fonction excel SOUS.TOTAL(103,Plage) mais en ne comptant que les valeurs distinctes (pas les doublons) ' Exemples d'appel Excel par Feuil1!A1 formula : ' =NbVal_Distinct_Visible(A2:A858) & " Libelle_de_Entité_colA" ' =NbVal_Distinct_Visible(A2:A858) & "/" & NbVal_Distinct(A2:A858) & " Libelle_de_Entité_colA" Dim wCell As Range Dim NbValDistinctVisible& Dim ListValuesDistinctVisible$ ListValuesDistinctVisible$ = "|" '' ---------------------------------------------- '' version 1 avec SpecialCells(xlCellTypeVisible) '' ---------------------------------------------- '' Fonctionne appellée par VBA mais quand appelée par Excel, inclus aussi les lignes invisibles 'Dim oRangeVisibles As Range 'Set oRangeVisibles = oRange.SpecialCells(xlCellTypeVisible) 'Debug.Print "oRangeVisibles.Cells.Count = "; oRangeVisibles.Cells.Count 'For Each wCell In oRangeVisibles ' If Not IsEmpty(wCell.Value) Then ' Debug.Print "R"; wCell.Row; "C"; wCell.Column; " "; wCell.Value ' If InStr(ListValuesDistinctVisible$, "|" & wCell.Value & "|") = 0 Then ' NbValDistinctVisible& = NbValDistinctVisible& + 1 ' ListValuesDistinctVisible$ = ListValuesDistinctVisible$ & wCell.Value & "|" ' End If ' End If 'Next wCell 'Debug.Print "NbVal_Distinct_Visible ="; NbValDistinctVisible& 'NbVal_Distinct_Visible$ = NbValDistinctVisible& ' ---------------------------------- ' Version 2 avec EntireRow.Hidden ' ---------------------------------- For Each wCell In oRange 'Debug.Print "R"; wCell.Row; "C"; wCell.Column; " "; wCell.Value; " Visible="; NbValDistinctVisible&; " / NbVal="; NbValDistinctTotal& If Not wCell.EntireRow.Hidden Then If Not wCell.EntireColumn.Hidden Then If Not IsEmpty(wCell.Value) Then If InStr(ListValuesDistinctVisible$, "|" & wCell.Value & "|") = 0 Then ListValuesDistinctVisible$ = ListValuesDistinctVisible$ & wCell.Value & "|" NbValDistinctVisible& = NbValDistinctVisible& + 1 End If End If End If End If Next wCell NbVal_Distinct_Visible = NbValDistinctVisible& End Function Public Function NbVal_Distinct(oRange As Range) ' ---------------------------------------------------------------------------- ' Nouvelle fonction Excel par BILLOT Michel ' Compte les valeurs Distintes sur la Plage oRange ' ---------------------------------------------------------------------------- ' Idem fonction excel SOUS.TOTAL(3,Plage) mais en ne comptant que les valeurs distinctes (pas les doublons) ' Exemples d'appel Excel par Feuil1!A1 formula : ' =NbVal_Distinct(A2:A858) & " Libelle_de_Entité_colA" ' =NbVal_Distinct_Visible(A2:A858) & "/" & NbVal_Distinct(A2:A858) & " Libelle_de_Entité_colA" Dim wCell As Range Dim NbValDistinctTotal& Dim ListValues$ ListValues$ = "|" For Each wCell In oRange If Not IsEmpty(wCell.Value) Then If InStr(ListValues$, "|" & wCell.Value & "|") = 0 Then ListValues$ = ListValues$ & wCell.Value & "|" NbValDistinctTotal& = NbValDistinctTotal& + 1 End If End If Next wCell NbVal_Distinct = NbValDistinctTotal& End Function
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.