XL 2013 Création tableau récapitulatif

[Farfelux]

Bonjour à tous,

Tout d'abord, désolé si ma demande est bizarre ou infaisable, je découvre l'existence des Macros et ne sais pas encore ce qui est faisable ou pas avec.

J'aimerais savoir si il est possible d'avoir une macro qui, selon la valeur qui se trouve dans les case de la colonne A, va lister toutes les valeurs correspondante qui se trouve dans la colonne B et compter le nombre de ligne entre les valeurs correspondant au critère.
Pour exemple, dans le fichier en PJ, est il possible qu'un macro liste toutes les valeurs en colonne B lorsque dans la colonne A le mots "Rubrique" apparait et compte le nombre de ligner entre les mots "Rubrique" ?

Merci de votre retour

 

[sylvanu]

Bonjour Farfelux et bienvenu sur XLD,
Un essai en PJ.
J'ai fait simple par lecture cellule. Si votre liste est très grande, on peut être beaucoup plus rapide.
Mais je voulais être simple avec des commentaires. Avec :

Sub TrouverMot()
    Dim LigneLue%, LigneEcrite%, Mot$, Début%
    Range("B10:C1000").ClearContents                            ' Effacement des anicennes valeurs
    Range("C5:C6").ClearContents
    LigneLue = 1                                                ' Init pointeur de lecture
    LigneEcrite = 10                                            ' Init pointeur d'écriture
    Mot = Range("C2")                                           ' Lecture du mot à rechercher
    Début = 0
    With Sheets("012-MATERIAUX_SIMC_SAS")                       ' En utilisant cette page
        While .Cells(LigneLue, "A") <> ""                       ' Tant que la colonne A n'est pas vide
            If .Cells(LigneLue, "A") = Mot Then                 ' Si Mot trouvé
                Cells(LigneEcrite, "B") = LigneLue - Début      ' Calculer écart et l'écrire
                Cells(LigneEcrite, "C") = .Cells(LigneLue, "B") ' ecrire le mot trouvé en colonne B
                Début = LigneLue                                ' Re init de début
                LigneEcrite = LigneEcrite + 1                   ' Incrément ligne d'écriture
            End If
            LigneLue = LigneLue + 1                             ' Incrément ligne de lecture
        Wend
    End With
    Range("C5") = LigneLue - 1                                  ' Ecrire le nombre de lignes trouvées
    Range("C6") = LigneEcrite - 10                              ' Ecrire le nombre d'occrence trouvées.
End Sub

J'ai mis les résultats sur une seconde feuille.
Le problème est le premier mot trouvé, quelle est l'interligne ?
0 puisque c'est le premier où le numéro de ligne ?

 

[sylvanu]

Re,
"Just for the fun" une PJ regroupant macro précédente et macro utilisant des arrays.
J'ai "agrandi" la liste à analyser à 5000 lignes.
Regardez les temps d'exécution avec les deux approches.
Avec :

Sub TrouverMotParArray()
   Dim LigneLue%, LigneEcrite%, Mot$, Début%, Tablo, TabloOut, T0
    T0 = Timer                                                  ' Mémorisation temps de départ
    Range("B10:C10000").ClearContents                            ' Effacement des anciennes valeurs
    Range("C5:C7").ClearContents
    LigneLue = 1                                                ' Init pointeur de lecture dans array Tablo
    LigneEcrite = 0                                             ' Init pointeur d'écriture dans array TabloOut
    Mot = Range("C2")                                           ' Lecture du mot à rechercher
    Début = 0
    With Sheets("012-MATERIAUX_SIMC_SAS")                       ' En utilisant cette page
        DL = .Range("A65500").End(xlUp).Row                     ' Calcul de la dernière ligne utilisée
        Tablo = .Range("A1:B" & DL)                             ' Transfert du tableau dans un array ( tableau VBA )
        ReDim TabloOut(UBound(Tablo), 1)
        For i = 1 To UBound(Tablo)                              ' Pour toutes les lignes du tableau, UBound(Tablo) donne la dernière ligne
            If Tablo(i, 1) = Mot Then                           ' Si Mot trouvé
                TabloOut(LigneEcrite, 0) = i - Début            ' Calculer écart et l'écrire
                TabloOut(LigneEcrite, 1) = Tablo(i, 2)          ' Ecrire le mot trouvé
                Début = i                                       ' Re init de début
                LigneEcrite = LigneEcrite + 1                   ' Incrément ligne d'écriture
            End If
        Next i
    End With
    Range("C5") = UBound(Tablo)                                 ' Ecrire le nombre de lignes trouvées
    Range("C6") = LigneEcrite                                   ' Ecrire le nombre d'occrence trouvées.
    Range("C7") = Format(1000 * (Timer - T0), "0 ms")           ' Ecrire le temps d'éxécution
    Range("B10").Resize(UBound(TabloOut, 1), 2) = TabloOut      ' Transfert de TabloOut dans la feuille
End Sub

 

[soan]

Bonjour Farfelux, sylvanu,

bienvenue sur le site XLD !

ton pseudo un peu farfelu est vraiment "Farfelux" ? ce n'est pas plutôt "Farfelix" ? comme "Astérix", "Obélix", "Idéfix", "Ordralphabétix", "Panoramix", "Cétautomatix", "Assurancetourix"...

j'demande ça car si t'étais gaulois, j'aurais bien aimé avoir un peu d'potion magique, moi !
j'suis pas tombé dans la marmite quand j'étais petit, comme un certain Obélix ! ​

soan