XL 2019 Compte Items transpose lignes

  • Initiateur de la discussion Initiateur de la discussion Hoareau
  • 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 !

Hoareau

XLDnaute Occasionnel
Bonjour

sur la base de CompteItems de boisgonthier

je voudrais transposer le resultat en lignes au lieu des colonnes
ce qui est fait dans la macro ci-dessous, mais dans l'affichage ce n'est que le premier item et son decompte qui s'affiche dans toutes le cellules

merci

Sub CompteItems_2()

Set Plage = Range("a2", [A3].End(xlToRight))

Plage.Select
Set mondico = CreateObject("Scripting.Dictionary")
For Each c In Plage
mondico(c.Value) = mondico(c.Value) + 1
Next c
[A5].Resize(, mondico.Count) = Application.Transpose(mondico.keys)
[A6].Resize(, mondico.Count) = Application.Transpose(mondico.items)

End Sub
 
Bonjour @Hoareau,

Comme ceci ? :
VB:
Sub CompteItems()
Set mondico = CreateObject("Scripting.Dictionary")
For Each c In Range("a2", [A3].End(xlToRight)): mondico(c.Value) = mondico(c.Value) + 1: Next c
[C12].Resize(9999, 2).Clear
[C12].Resize(mondico.Count, 1) = Application.Transpose(mondico.keys)
[d12].Resize(mondico.Count, 1) = Application.Transpose(mondico.items)
[C12].Resize(mondico.Count, 2).Sort key1:=[C12], order1:=xlAscending, Header:=xlNo, Orientation:=xlSortColumns
End Sub

Sub CompteItems_2()
Set Plage = Range("a2", [A3].End(xlToRight))
Set mondico = CreateObject("Scripting.Dictionary")
For Each c In Plage: mondico(c.Value) = mondico(c.Value) + 1: Next c
[a5].Resize(2, Columns.Count).Clear
[a5].Resize(, mondico.Count) = mondico.keys
[A6].Resize(, mondico.Count) = mondico.items
[a5].Resize(2, mondico.Count).Sort key1:=[a5], order1:=xlAscending, Header:=xlNo, Orientation:=xlSortRows
End Sub
 
- 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

Réponses
12
Affichages
552
  • Question Question
Microsoft 365 VBA Transpose
Réponses
11
Affichages
831
Réponses
0
Affichages
515
Retour