Macro : copier/coller valeur unique sans doublons + compteur

Mateo34

XLDnaute Nouveau
Bonjour à tous,

Je fais appel à vous car je souhaite depuis une feuille connecté à une requête SQL copier des données sur une autre feuille pour pouvoir faire un tableau croisé dynamique

Voilà mon problème :

En Feuil1 j'ai une colonne "B" avec des données en doubles/tribles et avec des lignes vides :

Ex Colonne B Feuil1 :
NOM de Colonne
RIRI
FIFI
LOULOU
FIFI
Vide
Vide
LOULOU
Vide
FIFI

Et je souhaiterais arriver à ça sur la feuil 2 :
Nom de colonne A Colonne B
FIFI 3
LOULOU 2
RIRI 1

En espérant que ma demande soit compréhensible

Merci par avance de votre aide.
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : Macro : copier/coller valeur unique sans doublons + compteur

Bonsoir Mateo, bonsoir le forum,

Le code ci-dessous devra être adapté à ton fichier puisque tu n'as pas daigné fournir un petit exemple :
Code:
Sub Macro1()
Dim O1 As Object 'déclare la variable O1 (Onglet 1)
Dim O2 As Object 'déclare la variable O2 (Onglet 2)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim cel As Range 'déclare la variable CEL (CELlule)
Dim D As Object 'déclare la variable D (Dictionnaire)

Set O1 = Sheets("Feuil1") 'définit l'onglet O1
Set O2 = Sheets("Feuil2") 'définit l'onglet O2
DL = O1.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 1 (=A) de l'onglet O1
Set PL = O1.Range("A2:A" & DL) 'définit la plage PL
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For Each cel In PL 'boucle sur toutes les cellules CEL de la plage PL
    If cel.Value <> "" Then D(cel.Value) = D(cel.Value) + 1 'alimente le dictionnaire
Next cel 'prochaine valeur de la boucle
'renvoie en A1 de l'onglet O2 la liste des élément uniques
O2.Range("A1").Resize(D.Count, 1) = Application.Transpose(D.keys)
'renvoie en B1 de l'onglet O2 le nombre de fois que l'élément apparaît dans la liste
O2.Range("B1").Resize(D.Count, 1) = Application.Transpose(D.Items)
End Sub

Là où j'ai appris à l'utiliser : Objet dictionary
 

Mateo34

XLDnaute Nouveau
Re : Macro : copier/coller valeur unique sans doublons + compteur

Bonsoir, je me permet de vous solliciter à nouveau, le code de Robert ci-dessus fonctionne parfaitement, mais je n'arrive pas à rajouter un ordre de tri.

Je souhaiterais que les classer en mode décroissant.

Merci par avance
 

Discussions similaires

Statistiques des forums

Discussions
311 733
Messages
2 082 019
Membres
101 872
dernier inscrit
Colin T