XL 2010 (Résolu) Résumé de tous les mot indiqués sur des feuilles

toietmoi

XLDnaute Nouveau
Bonjour

Tout d'abords, merci pour le temps que vous allez consacrer a mon problème.
J'ai un fichier excel qui comprend environ 200 feuilles différentes.
Chaque feuille contient environ 100 cellules en format texte avec des mots.
Ces mots se retrouve dans les différentes feuilles.

J'aimerais me créer une feuille (Résumé) qui comprendrais tous les mots trouvés et le nombre de fois trouvé dans un champs a coté de ce dit mot.
Au pire si ce n'est pas possible, de seulement copié tous les mots dans un champs et indiqué dans des cellules différentes le mot plusieurs fois.

Mon but final etant d'avoir un genre de tableau avec tous les mots des feuilles et le nombre de fois que celui-la a été inscrit.
Merci pour votre aide précieuse, je cherche mais n'y arrive pas.

Faut dire que je suis assez débutant en excel.
 

toietmoi

XLDnaute Nouveau
Salut Patrice

Merci pour la réponse :)
Il peut y avoir plusieurs mots par cellule mais c'est toujours en format texte et il n'y a aucun chiffre.
Si possible éviter la ligne de titre mais c'est pas une obligation.
Il n'y a aucune formule.

ex: en ligne 2, collone 2 , il y a le mot chat, ensuite en ligne 2 collone 3 il y a le mot chien etc...
Il pourrait aussi avoir : Chien Gris ou chat noir... mais pour moi c'est une instance différence de simplement chat ou chien.

a la fin j'aimerais une feuille qui me sors tous les mots différents ainsi que le nombre :

2 Chat
4 Chat noir
3 chiens
1 Chien gris

Ou si c'est pas possible :
Chat
Chat
Chat noir
Chat noir
Chat noir
Chat noir
Chien
Chien
Chien
Chien gris


Merci :)
 

toietmoi

XLDnaute Nouveau
Merci
J'ai trouvé comment copié la macro que vous avez créer.
Est-il possible de ne prendre pendre en compte les 2 premieres lignes de chaques feuilles (titres) et de pas pendre en compte la premiere feuille (qui est une feuille explicative)?
Merci énormémenté
 

Patrice33740

XLDnaute Impliqué
Bonjour,

Essaies :
VB:
Sub ListeLesMotsDuClasseur()
' Ajouter une référence à Microsoft Scripting Runtine
Const N$ = "Résumé"
Dim F As Worksheet
Dim R As Worksheet
Dim D As Scripting.Dictionary
Dim T As Variant
Dim M As Variant
Dim L As Long
Dim C As Long
Dim I As Integer

  With ThisWorkbook
    ' Définir la feuille Résumé
    On Error Resume Next
    Set R = .Worksheets(N)
    On Error GoTo 0
    If R Is Nothing Then
      'Si elle n'existe pas, la créer.
      Set R = .Worksheets.Add(before:=.Worksheets(1))
      R.Name = N
    End If
    ' Créer la liste des mots
    Set D = New Scripting.Dictionary
    ' Analyser chaque feuille ...
    For Each F In .Worksheets
      ' ... sauf la feuille résumé
      If F.Name <> N Then
        ' Transférer les valeurs des cellules dans un tableau sauf les titres
        T = F.UsedRange.Offset(1).Value
        ' Analyser chaque colonne du tableau ...
        For C = LBound(T, 2) To UBound(T, 2)
          ' ... et chaque ligne (cellule) de la colonne
          For L = LBound(T, 1) To UBound(T, 1)
            ' Si la donnée est un texte ...
            If VarType(T(L, C)) = vbString Then
              D(T(L, C)) = D(T(L, C)) + 1
            End If
          Next L
        Next C
      End If
    Next F
  End With
  ' Mettre à jour la liste des mots
  R.Columns("A:B").ClearContents
  R.Range("A1").Value = "Nombre d'occurences"
  R.Range("B1").Value = "Liste des mots"
  R.Range("A2").Resize(D.Count) = Application.Transpose(D.Items)
  R.Range("B2").Resize(D.Count) = Application.Transpose(D.Keys)
  R.Columns.AutoFit
 
End Sub
 

toietmoi

XLDnaute Nouveau
Merci pour les explications.
Voici ce que ca me donne.


upload_2017-8-17_10-53-26.png


upload_2017-8-17_10-54-3.png
 

zebanx

XLDnaute Accro
Bonjour à tous,

@Patrice33740
Merci et bravo (!).
J'ai recopié cet excellent code - sans aucune modification -mais il y a des écarts sur la sommation des valeurs de 3 wks.
Pas compris pourquoi car les références sont toutes retrouvées, même sur des zones non adjacentes aux premières cellules.:eek:

Et, - c'était peut-être demandé -, il n'y a pas d'aggrégation des mots suivants UpperCase ou LowerCase (testé sans accent sur reference a par exemple au lieu de REFERENCE A).

Cdlt
thierry
 

Pièces jointes

  • code_compte OCCURENCE mots dans wbk (boucle sur wks).xls
    58.5 KB · Affichages: 33

Patrice33740

XLDnaute Impliqué
Re,

Sans référence à Microsoft Scripting Runtime :
VB:
Sub ListeLesMotsDuClasseur()
Const N$ = "Résumé"
Dim F As Worksheet
Dim R As Worksheet
Dim D As Variant
Dim T As Variant
Dim M As Variant
Dim L As Long
Dim C As Long
Dim I As Integer

  With ThisWorkbook
    ' Définir la feuille Résumé
    On Error Resume Next
    Set R = .Worksheets(N)
    On Error GoTo 0
    If R Is Nothing Then
      'Si elle n'existe pas, la créer.
      Set R = .Worksheets.Add(before:=.Worksheets(1))
      R.Name = N
    End If
    ' Créer la liste des mots
    Set D = CreateObject("Scripting.Dictionary")
    ' Analyser chaque feuille ...
    For Each F In .Worksheets
      ' ... sauf la feuille résumé
      If F.Name <> N Then
        ' Transférer les valeurs des cellules dans un tableau sauf les titres
        T = F.UsedRange.Offset(1).Value
        ' Analyser chaque colonne du tableau ...
        For C = LBound(T, 2) To UBound(T, 2)
          ' ... et chaque ligne (cellule) de la colonne
          For L = LBound(T, 1) To UBound(T, 1)
            ' Si la donnée est un texte ...
            If VarType(T(L, C)) = vbString Then
              ' ... créer un tableau des mots de la cellule
              M = Split(Replace(T(L, C), Chr(10), " "), " ")
              ' Analyser chaque mot
              For I = UBound(M) To LBound(M)
                D(M(I)) = D(M(I)) + 1
              Next I
            End If
          Next L
        Next C
      End If
    Next F
  End With
  ' Mettre à jour la liste des mots
  R.Columns("A:B").ClearContents
  R.Range("A1").Value = "Liste des mots"
  R.Range("B1").Value = "Nombre d'occurences"
  R.Range("A2").Resize(D.Count) = Application.Transpose(D.Keys)
  R.Range("B2").Resize(D.Count) = Application.Transpose(D.Items)
  R.Columns.AutoFit
 
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 886
Membres
101 830
dernier inscrit
sonia poulaert