Microsoft 365 Comment rechercher des occurrences inconnues

  • Initiateur de la discussion Initiateur de la discussion lucarn
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

lucarn

XLDnaute Occasionnel
Bonjour,
Je réédite ma question sous une forme nouvelle parce que j'avais mal posé le problème et que je ne parviens pas à transformer le code qu'on m'a donné pour l'adapter à mon question.
Voici mon problème. Dans un fichier, j’ai plusieurs feuilles qui correspondent au même formulaire. En général, je me sers de listes déroulantes pour beaucoup de cellules. Mais, j’en ai quelques-unes à remplir à la main qui correspondent à des questions ouvertes. Lorsque je fais la synthèse des formulaires, je parviens facilement à compter les occurrences lorsqu’elles viennent de listes déroulantes parce que je connais toutes les possibilités. Mais lorsque la réponse est « ouverte », je ne connais pas les occurrences qui ont été créées.
J’aurai voulu une macro qui aille chercher les différentes occurrences (qui sont toujours à la même place), et lorsqu’une occurrence sort plusieurs fois, savoir combien de fois elle est sortie.
J'ajoute une précision qui n'était pas dans mon premier sujet : il n'y a qu'une cellule concernée par feuille, mais il y a un nombre de feuilles indéterminé. Donc, le fichier que je mets en pièce jointe est à 4 fiches mais il pourrait être de 10 ou de 30.
Tous les onglets s'appellent "fiche etc"

Ci-joint un fichier test avec le résultat attendu dans l'onglet synthèse
 

Pièces jointes

Dernière édition:
salut 🙂

juste pour saluer pierrejean

j'adore ces codes :

VB:
Sub synthese()
Set dico = CreateObject("Scripting.dictionary")
For Each sh In Sheets
  If sh.Name <> "Synthèse" Then
     For n = 2 To sh.Range("A" & Rows.Count).End(xlUp).Row
         dico(Trim(sh.Range("A" & n))) = dico(Trim(sh.Range("A" & n))) + 1
     Next
  End If
Next
a = dico.keys
b = dico.items
For n = LBound(a) To UBound(a)
 Sheets("Synthèse").Range("B" & n + 2) = a(n)
 Sheets("Synthèse").Range("C" & n + 2) = b(n)
Next
End Sub

c'est clair, limpide

merci
 
Bonsoir à @lucarn, @pierrejean 🙂, @Hervé 🙂

Pour le fun, une version sans dictionary (pour les possesseurs d'une machine Apple). La synthèse est mise à jour quand on sélectionne la feuille "Synthèse".
Le code:
VB:
Private Sub Worksheet_Activate()
Dim sh, Indice As New Collection, x, aux, i&
On Error Resume Next
   For Each sh In ThisWorkbook.Worksheets
      If LCase(Trim(sh.Name)) Like "fiche #*" Then
         x = LCase(Application.Trim(sh.Range("a2"))): aux = Empty: aux = Indice(x)
         If IsEmpty(aux) Then Indice.Add Array(x, 1), x Else aux(1) = aux(1) + 1: Indice.Remove x: Indice.Add aux, x
      End If
   Next sh
On Error GoTo 0
   Worksheets("Synthèse").Range("b2:c" & Rows.Count).ClearContents
   If Indice.Count < 1 Then Exit Sub
   ReDim r(1 To Indice.Count, 1 To 2)
   For i = 1 To Indice.Count: aux = Indice.Item(i): r(i, 1) = aux(0): r(i, 2) = aux(1): Next
   Worksheets("Synthèse").Range("b2").Resize(Indice.Count, 2) = r
End Sub
 

Pièces jointes

Bonsoir à @lucarn, @pierrejean 🙂, @Hervé 🙂

Pour le fun, une version sans dictionary (pour les possesseurs d'une machine Apple). La synthèse est mise à jour quand on sélectionne la feuille "Synthèse".
Le code:
VB:
Private Sub Worksheet_Activate()
Dim sh, Indice As New Collection, x, aux, i&
On Error Resume Next
   For Each sh In ThisWorkbook.Worksheets
      If LCase(Trim(sh.Name)) Like "fiche #*" Then
         x = LCase(Application.Trim(sh.Range("a2"))): aux = Empty: aux = Indice(x)
         If IsEmpty(aux) Then Indice.Add Array(x, 1), x Else aux(1) = aux(1) + 1: Indice.Remove x: Indice.Add aux, x
      End If
   Next sh
On Error GoTo 0
   Worksheets("Synthèse").Range("b2:c" & Rows.Count).ClearContents
   If Indice.Count < 1 Then Exit Sub
   ReDim r(1 To Indice.Count, 1 To 2)
   For i = 1 To Indice.Count: aux = Indice.Item(i): r(i, 1) = aux(0): r(i, 2) = aux(1): Next
   Worksheets("Synthèse").Range("b2").Resize(Indice.Count, 2) = r
End Sub
Merci mapomme et bonne journée
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Retour