Compter le nombre de "nom" dans plusieurs feuilles

Le 28/06/2013 à 16:16

Bonjour,

je me demandé si il etait possible de compter le nombre de "Nom" identique ce trouvant toujours dans la même colonne "C" mais sur 4 feuilles différentes.

Exemple:

j'ai 4 feuilles nommé : Est, Ouest, Nord, Sud

à l'intérieur de chaque feuille, dans la colonne "C" ce trouvera le nom de différente personne, il ce peut que certaine personne apparaisse plusieurs fois dans cette colonne.

Je souhaiterai créer une 5 feuilles "Resultat" dans laquelle je j'afficherai les résultats de ma rechercher :

Combien de fois on retrouve le nom "DUPONT" dans toutes les feuilles....

J'ai trouvé cette formule, mais qui ne marche que pour une feuille =NB.SI($C:$C;"*DUPONT*"), puis je trouvé la même formule mais en incluant les différentes feuilles.

Merci de votre aide

Le 28/06/2013 à 17:59

Bonjour. Bienvenue sur le Forum

Avec une formule 3D

=SOMMEPROD(NB.SI(INDIRECT(Liste_Feuilles&"!$C$1:$C$25");C2))

ou Liste_Feuilles représente la liste des feuilles

Exemple joint

Cordialement

695classeur1.zip (3.28 Ko)
Le 28/06/2013 à 21:54

Bonsoir,

Un exemple en vba et l'objet Dictionary liste triée.

Ctrl+a pour lancer la procédure

Option Explicit
Public Sub Consolidation()
'Ctrl+a pour lancer la procédure
Dim Derligne As Long
Dim i As Byte
Dim Mondico
Dim c As Range

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With

    On Error Resume Next
        Worksheets("Résultat").Delete
    On Error GoTo 0

    Set Mondico = CreateObject("Scripting.Dictionary")

    For i = 1 To 4
        With Worksheets(i)
            Derligne = .Range("A" & Rows.Count).End(xlUp).Row
            For Each c In .Range("A2:A" & Derligne)
                Mondico(c.Value) = Mondico(c.Value) + 1
            Next c
        End With
    Next

    ActiveWorkbook.Worksheets.Add after:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = "Résultat"
    Cells(1, 1) = "Noms"
    Cells(1, 2) = "Nombre"
    Rows(1).Font.Bold = True

    [A2].Resize(Mondico.Count, 1) = Application.Transpose(Mondico.keys)
    [B2].Resize(Mondico.Count, 1) = Application.Transpose(Mondico.items)
    [A1].Sort Key1:=[A2], Order1:=xlAscending, Header:=xlYes
    'Total si nécessaire
    'Derligne = Range("B" & Rows.Count).End(xlUp).Row
    'Cells(Derligne + 1, 2) = Application.Sum(Range("B2:B" & Derligne))

    Set Mondico = Nothing

    Application.DisplayAlerts = True

End Sub
69kweb-dictionary-v1.zip (14.86 Ko)
Le 30/06/2013 à 18:49

Bonjour à tous

Juste pour le fun, une proposition entre les deux précédentes, avec un tableau complet à l'arrivée.

Private Sub CommandButton1_Click()
Dim I&, J&, K&, F As Worksheet, DReport As Object
Set DReport = CreateObject("Scripting.Dictionary")
Cells.ClearContents
For Each F In Worksheets
    If F.Name <> ActiveSheet.Name Then
        J = J + 1
        Cells(1, Columns.Count).End(1)(1, 2) = F.Name
        For I = 1 To F.Cells(Rows.Count, 3).End(3).Row
            DReport(F.Cells(I, 3).Value) = ""
        Next I
    End If
Next F
K = DReport.Count
Cells(2, 1).Resize(K, 1).Value = Application.Transpose(DReport.Keys)
Cells(2, 2).Resize(K, J).FormulaLocal = "=NB.SI(INDIRECT(""'""&B$1&""'!$C:$C"");$A2)"
Cells(1, 6).Value = "Somme"
Cells(2, 6).Resize(K, 1).FormulaLocal = "=SOMME($B2:$E2)"
UsedRange.Value = UsedRange.Value
End Sub

Cordialement

99classeur1-4.zip (14.16 Ko)
Le 17/04/2019 à 14:46

Bonjour

je suis très intéressé par une petite modification de ce code étant un très grand débutant en vba...

j'aurais voulu faire la recherche sur une sélection A1H24 dans toutes les feuilles de mon classeur.

pouvez-vous m'aider ?

merci d'avance

Le 17/04/2019 à 18:44

Bonjour à tous

Avec ce que j'ai compris :

Private Sub CommandButton1_Click()
Dim I&, J&, K&, F As Worksheet, DReport As Object
Set DReport = CreateObject("Scripting.Dictionary")
Cells.ClearContents
For Each F In Worksheets
    If F.Name <> ActiveSheet.Name Then
        J = J + 1
        Cells(1, Columns.Count).End(1)(1, 2) = F.Name
        For I = 1 To 24
            For L = 1 To 8
                If F.Cells(I, L).Value <> "" Then DReport(F.Cells(I, L).Value) = ""
            Next L
        Next I
    End If
Next F
K = DReport.Count
Cells(2, 1).Resize(K, 1).Value = Application.Transpose(DReport.Keys)
Cells(2, 2).Resize(K, J).FormulaLocal = "=NB.SI(INDIRECT(""'""&B$1&""'!$A$1:$H$24"");$A2)"
Cells(1, 6).Value = "Somme"
Cells(2, 6).Resize(K, 1).FormulaLocal = "=SOMME($B2:$E2)"
UsedRange.Value = UsedRange.Value
End Sub

Cordialement

Le 18/04/2019 à 09:17

Bonjour

Hier soir j'ai été trop rapide dans ma réponse.

Une version plus aboutie et commentée, même si elle reste améliorable.

Private Sub CommandButton1_Click()
Dim I&, J&, K&, L&, F As Worksheet, DReport As Object
Dim L_Deb&, L_Fin&, Col_Deb&, Col_Fin&

L_Deb = 1 'Première ligne de la plage à parcourir sur chaque feuille
L_Fin = 24 'Dernière ligne de la plage à parcourir sur chaque feuille
Col_Deb = 1 'Première colonne de la plage à parcourir sur chaque feuille
Col_Fin = 8 'Dernière colonne de la plage à parcourir sur chaque feuille

Set DReport = CreateObject("Scripting.Dictionary")
Cells.ClearContents 'on vide les cellule de la feuille active
For Each F In Worksheets 'Pour chaque feuille du classeur
    If F.Name <> ActiveSheet.Name Then  'si ce n'est pas la feuille active
        J = J + 1 ' Compteur de feuilles
        Cells(1, Columns.Count).End(1)(1, 2) = F.Name  'La première cellule vide dal feuille active prend le nom de la feuille parcourue
        For I = L_Deb To L_Fin 'pour les lignes choisies  de la feuille parcourue
            For L = Col_Deb To Col_Fin 'pour les colonnes choisies de la feuille parcourue
                If F.Cells(I, L).Value <> "" Then DReport(F.Cells(I, L).Value) = "" 'Si la cellule n'est pas vide on récupère le contenu
            Next L 'prochaine colonne
        Next I 'Prochaine ligne
    End If
Next F 'prochaine feuille
K = DReport.Count 'K = Nombre de mots trouvés
'On colle les formules de recherche
Cells(2, 1).Resize(K, 1).Value = Application.Transpose(DReport.Keys) 'liste des mots trouvés
Cells(2, 2).Resize(K, J).FormulaLocal = "=NB.SI(INDIRECT(""'""&B$1&""'!" & Cells(L_Deb, Col_Deb).Address & ":" & Cells(L_Fin, Col_Fin).Address & """);$A2)"
Cells(1, J + 2).Value = "Somme"
Cells(2, J + 2).Resize(K, 1).FormulaLocal = "=SOMME(B2:" & Replace(Cells(2, J + 1).Address, "$", "") & ")"
UsedRange.Value = UsedRange.Value 'on écrase les formules
End Sub

Cordialement

Le 18/04/2019 à 10:42

Merci infiniment !

je suis épaté

Le 18/04/2019 à 16:18

re Bonjour,

cette macro me fait vraiment des miracles, encore merci. Serait-il possible d'envisager une petite amélioration ? Pourrait on avoir la possibilité de classer les mots par ordre alphabétique ?

dam

Le 18/04/2019 à 16:29

Re

Si tu as 2007 ou plus récent, autant faire un tableau de feuille avec les filtres qui vont bien(voir pièce jointe).

Cordialement

112copie-de-classeur1-4.zip (16.54 Ko)
Le 06/08/2019 à 10:54

Re Bonjour à tous

grâce à votre aide précieuse mon fichier vit bien. J'aimerais aujourd’hui avoir la possibilité d'exclure plusieurs feuilles dans la recherche... j'ai tenté pas mal de choses et l'évidence montre que je suis bien loin de pouvoir me débrouiller seul...

merci d'avance

Le 06/08/2019 à 15:20

Bonjour

Comme ça ?

Private Sub CommandButton1_Click()
Dim I&, J&, K&, L&, F As Worksheet, DReport As Object
Dim L_Deb&, L_Fin&, Col_Deb&, Col_Fin&
Dim ListeExclus$

'Liste des onglets a ignorer (commence et fini par une virgule)
ListeExclus = ",Toto,Titi,"

L_Deb = 1 'Première ligne de la plage à parcourir sur chaque feuille
L_Fin = 24 'Dernière ligne de la plage à parcourir sur chaque feuille
Col_Deb = 1 'Première colonne de la plage à parcourir sur chaque feuille
Col_Fin = 8 'Dernière colonne de la plage à parcourir sur chaque feuille

Set DReport = CreateObject("Scripting.Dictionary")
Cells.Clear 'on vide les cellule de la feuille active
For Each F In Worksheets 'Pour chaque feuille du classeur
    If F.Name <> ActiveSheet.Name And InStr(ListeExclus, "," & F.Name & ",") = 0 Then 'si la feuille n'est pas la feuille active et ne fait pas partie des exclus
        J = J + 1 ' Compteur de feuilles
        Cells(1, Columns.Count).End(1)(1, 2) = F.Name  'La première cellule vide dal feuille active prend le nom de la feuille parcourue
        For I = L_Deb To L_Fin 'pour les lignes choisies  de la feuille parcourue
            For L = Col_Deb To Col_Fin 'pour les colonnes choisies de la feuille parcourue
                If F.Cells(I, L).Value <> "" Then DReport(F.Cells(I, L).Value) = "" 'Si la cellule n'est pas vide on récupère le contenu
            Next L 'prochaine colonne
        Next I 'Prochaine ligne
    End If
Next F 'prochaine feuille
K = DReport.Count 'K = Nombre de mots trouvés
'On colle les formules de recherche
Cells(1, 1).Value = "Noms"
Cells(2, 1).Resize(K, 1).Value = Application.Transpose(DReport.Keys) 'liste des mots trouvés
Cells(2, 2).Resize(K, J).FormulaLocal = "=NB.SI(INDIRECT(""'""&B$1&""'!" & Cells(L_Deb, Col_Deb).Address & ":" & Cells(L_Fin, Col_Fin).Address & """);$A2)"
Cells(1, J + 2).Value = "Somme"
Cells(2, J + 2).Resize(K, 1).FormulaLocal = "=SOMME(B2:" & Replace(Cells(2, J + 1).Address, "$", "") & ")"
UsedRange.Value = UsedRange.Value 'on écrase les formules
ActiveSheet.ListObjects.Add(xlSrcRange, Range(Cells(1, 1), Cells(K, J + 2)), xlYes).Name = "Tableau1"
End Sub

Cordialement

Le 06/08/2019 à 17:13

Efgé, c'est limite énervant ça fonctionne parfaitement !

J'utilise ce fichier pour un pré planning. J'aimerais pouvoir double cliquer sur une cellule réservée à l'activité d'un personnel et avoir une fenêtre type pop up qui s'ouvre avec les différentes tâches qui peuvent lui être assignées. Nous travaillons bcp avec un code couleur, il faudrait donc que le nom de la tâche sélectionnée soit lié à une couleur de fond de cellule. Dernière info de taille nous travaillons en partagé (donc pas de mise en forme conditionnelle si j'ai bien compris...) et nous avons 52 feuilles, une par semaine... chaque feuille possède plusieurs tableaux, un par spécialité de personnel.

je ne suis pas sur que ça soit réalisable...

merci

Rechercher des sujets similaires à "compter nombre nom feuilles"