Microsoft 365 Extraire le nombre d'occurence d'un texte dans un tableau

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 !

PhilChx

XLDnaute Nouveau
Bonjour à tous.
Je développe une macro VBA et je souhaiterais extraire les textes qui sont différents dans une colonne (la colonne D dans l'exemple)
et récupérer la liste des textes (résultat en colonne F) et le nombre de textes différents (Colonne G) :
ExempleTableau.jpg


Quand on utilise le bouton Données/Filtre Excel doit forcément les extraire (içi A,B,C) car il affiche l'écran suivant :

ExempleFiltre.jpg


J'ai essayé la méthode Range.AutoFilter mais je n'arrive pas à récupérer les infos que je cherche

Bien sur je pourrais développer une boucle qui va lire ligne à ligne, mais mon fichier réel fait plusieurs milliers de lignes et cela risque d'être très lent.
Si une méthode existe dans Excel, elle sera certainement optimisée et très rapide.

Quelqu'un a t - il une idée ?

Merci d'avance,
Amitiés
Philippe
 
Re

Personnellement, je m'en suis sorti 😉
(merci le confinement)
Si le cœur t'en dit, tu peux tester
(NB:La feuille active doit se nommer Feuil1)
VB:
Sub mTest()
Créer_Exemple
Créer_TCD
End Sub
Private Sub Créer_Exemple()
formules = Array("=""NOM""&ROW()-1", "=""PRE""&RC[-1]", "=RANDBETWEEN(22000,35000)", "=CHAR(RANDBETWEEN(65,67))")
[A1:D1] = Array("Nom", "Prénom", "Code Postal", "Postes")
[A2:D2].Formula = formules: [A2:D30].FillDown: [A1:D30] = [A1:D30].Value
End Sub
Private Sub Créer_TCD()
Dim Source$, Desti$, TCD As PivotTable
Source = "Feuil1!R1C1:R30C4": Desti = "Feuil1!R3C7"
Set TCD = ActiveWorkbook.PivotCaches.Create(1, Source).CreatePivotTable(TableDestination:=Desti, TableName:=" ")
With TCD.PivotFields("Postes"): .Orientation = 1: .Position = 1: End With
TCD.AddDataField TCD.PivotFields("Nom"), "Nombre de Nom", xlCount
TCD.CompactLayoutRowHeader = "Postes différents"
TCD.DataPivotField.PivotItems("Nombre de Nom").Caption = "Nombre de postes"
End Sub
PS: J'ai fait cela en VBA pour occuper ce samedi morose et pluvieux
Mais tout cela se fait à la souris (sans macro)
 
Merci bcp.
Comme quoi le confinement nous donne le temps de réfléchir ! 😉
Deux façons de s'en sortir vraiment intéressantes.
J'ai progressé un peu en TCD, mais je piétinais un peu. Ta macro, Staples1600 m'ouvre de nouvelles perspectives.
Merci
Phil
 
Bonjour le fil,

=>PhilCrx
Euh, la macro c'était pas le but 😉
C'était juste pour créer un exemple

C'est plus simple, intuitif et ergonomique de manipuler les TCD manuellement.

NB: j'ai posté ce bout de code simplement par désœuvrement et parce que depuis le 22 mai 1968, trois heures de l’après-midi, je ne joins plus de fichier Excel sur les forums.
 
R@chid,

Merci des fonctions que tu as proposé.
Mais je voudrais créer une feuille depuis la macro et y intégrer ces fonctions
J'ai donc essayé :

Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "Feuil1"

Range("A2") = "UN"
Range("A3") = "DEUX"

'etc ....
'puis

Range("F2").Formula2 = "=UNIQUE(D2😀7)"
Range("G2").Formula2 = "=NBVAL(F2:F7)"

Le problème, c'est que le contenu de la Case G2 obtenue est :

PBMAcro2.jpg


J'obtiens en G2 l'erreur #NOM alors que F2 est OK

Si je monte le curseur dans la zone de saisie au dessus et que je valide :

PBMAcro3.jpg


J'obtiens le bon résultat :

PBMAcro3.jpg


Je ne sais pas d'où vient ce problème .
Quelqu'un a une idée ?

Merci !

Philippe
 

Pièces jointes

  • 1607269548378.png
    1607269548378.png
    275.1 KB · Affichages: 22
Merci Staple1600,
J'ai testé FormulaLocal , mais cela ne marchait pas.

mais finalement j'ai utilisé l'enregistreur de Macro qui m'a proposé :


Range("F2").Select
ActiveCell.Formula2R1C1 = "=UNIQUE(RC[-2]:R[5]C[-2])"

Range("G2").Select
ActiveCell.FormulaR1C1 = "=COUNTA(RC[-1]:R[5]C[-1])"

et ça fonctionne.
Amitiés

Phil
 
- 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