Vba deux nouvelles fonctions excel (nbval_distinct et nbval_distinct_visible) pour compter le nombre de valeurs distinctes s

Télécharger le projet
Commenter

Description

Ajout de deux nouvelles fonctions a Excel en complement de NBVAL et de SOUS.TOTAL

1°) NbVal_Distinct : Retourne le nombre de valeurs distinctes sur une plage
2°) NbVal_Distinct_Visible : Retourne le nombre de valeurs distinctes et visibles sur une plage.

Ces fonctions peuvent etre appelées par
VB + ExcelActiveX : NombreEntitésVisibles& = NbVal_Distinct_Visible (objetRange)
VBA : NombreEntitésVisibles& = NbVal_Distinct_Visible (objetRange)
EXCEL A1 formula : =NbVal_Distinct_Visible(A2:A858) & " Libelle_de_Entité_colA"

Utilisation :
Afficher dans le header d'un filtre le nombre d'entités visibles et le nommbre d'entités total

Exemple de formule a metttre dans la cellule "A1" pour un ActiveSheet.AutoFilter.Range(A1:A858)
=NbVal_Distinct_Visible(A2:A858) & "/" & NbVal_Distinct(A2:A858) & " Libelle_de_Entité_colA"

Voir egalement la sub routine FilterOnClick pour filtrer les données
en cliquant sur les cellules de la feuille sans passer par la liste déroulante.







.................................................................................................................................................................................................................................................

Source / Exemple :

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

Conclusion :

En attente d'avis utilisateurs.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.

Du même auteur (BILLOTmi)