Macro recherche des valeurs présentes dans colone

F

Fab57330

XLDnaute Junior
Bonjour,
J'ai un fichier comportant 3 feuilles excel. Chaque feuille comporte le même nombre de colonne, et les mêmes entêtes.

Sur chaque feuille, colonne "E", et ce sur n lignes (tout dépend du nombre de données que j'ai), des des chiffres variant entre 0 et 99.

Je souhaiterai en fait scrutter ces trois colonnes, et en extraire chaque numéro utilisé.

Par exemple:
Feuille 1, colone E (ligne par ligne): 1, 9, 1, 7
Feuille 2, colone E (ligne par ligne): 1, 9, 8, 7
Feuille 3, colone E (ligne par ligne): 3, 9, 1, 7

La macro dirait donc que nous avons les chiffres suivants d'utilisés : 1, 3, 7, 8, 9

Ce genre de macro est réalisable ?

Merci d'avance,
Fab.
 
Trier par date Trier par votes
GeoTrouvePas

GeoTrouvePas

XLDnaute Impliqué
Re : Macro recherche des valeurs présentes dans colone

Bonsoir,

La petite macro suivante devrait répondre à tes besoins :


Code: 
Sub Chiffres_Utilises()
    Set MonDico = CreateObject("Scripting.Dictionary")
    With ThisWorkbook
        For i = 1 To .Sheets.Count
            j = 1
            While .Sheets(i).Cells(j, 5) <> ""
                MonDico(.Sheets(i).Cells(j, 5).Value) = ""
                j = j + 1
            Wend
        Next
    End With
    
    a = MonDico.keys
    Message = "Les chiffres utilisés sont : "
    For Cptr = 0 To MonDico.Count - 1
        Message = Message & Chr(13) & a(Cptr)
    Next
    
    MsgBox Message

End Sub

Attention : la macro passe à la feuille suivante dès qu'une cellule de la colonne E est vide !!!!
 
Dernière édition:
Vote positif 0 Vote négatif
Papou-net

Papou-net

XLDnaute Barbatruc
Re : Macro recherche des valeurs présentes dans colone

Bonjour Fab57330, GeoTrouvePas, le Forum,

GTP a été le plus rapide mais, comme je l'ai fait, je l'envoie.

Ma solution est très similaire à celle de GTP, sauf au niveau de la boucle de lecture de la colonne E qui admet des trous dans les lignes (sait-on jamais ?).

Cordialement.

PS : pour que cela fonctionne, il faut que la référence "Microsoft Scripting Runtime" soit chargée dans l'éditeur VBE.
 

Pièces jointes

  • Fab57330.xlsm
    19.2 KB · Affichages: 41
  • Fab57330.xlsm
    19.2 KB · Affichages: 36
  • Fab57330.xlsm
    19.2 KB · Affichages: 42
Vote positif 0 Vote négatif
F

Fab57330

XLDnaute Junior
Re : Macro recherche des valeurs présentes dans colone

Bonjour,
J'essaye de mettre tous les chiffre sur une même ligne, et séparée par ", " (VIRGULE et ESPACE). Le dernier chiffre quant a lui n'aura pas dee "VIRGULE et ESPACE". Cependant ca ne fonctionne pas ...

Code: 
Sub Chiffres_Utilises()
    Set MonDico = CreateObject("Scripting.Dictionary")
    With ThisWorkbook
        For i = 1 To .Sheets.Count
            j = 2
            While .Sheets(i).Cells(j, 5) <> ""
                MonDico(.Sheets(i).Cells(j, 5).Value) = ""
                j = j + 1
            Wend
        Next
    End With
   
    a = MonDico.keys
    Message = ""
    For Cptr = 0 To MonDico.Count - 1
        Message = Message & a(Cptr) & Chr(44) & Chr(1)
    Next
   
    MsgBox Message

End Sub

PS: Généralement j'ai entre 400.000 et 1.000.000 de valeurs par feuille. Et la boucle met beaucoup de temps. Il n'y a pas d'autres solution ?
 
Dernière édition:
Vote positif 0 Vote négatif
Papou-net

Papou-net

XLDnaute Barbatruc
Re : Macro recherche des valeurs présentes dans colone

Fab57330 à dit:
Et au niveau du temps d'ececution lol?
Car comme dit plus haut, j'ai souvent, par feuille, entre 400.000 et 1.000.000 de valeurs (rare sont les vides).

C'est jouable ?
Cliquez pour agrandir...

Il n'y a pas plus rapide qu'avec l'utilisation d'un tableau ou dictionnaire. Mais si tu as autant de valeurs par feuille, je doute que l'affichage par msgbox soit très adapté.

Par contre, j'ai oublié de programmer le bouton Extraction sur mon fichier précédent. Voici qui est réparé.

Cordialement.
 

Pièces jointes

  • Fab57330.xlsm
    22.2 KB · Affichages: 48
  • Fab57330.xlsm
    22.2 KB · Affichages: 50
  • Fab57330.xlsm
    22.2 KB · Affichages: 49
Dernière édition:
Vote positif 0 Vote négatif
F

Fab57330

XLDnaute Junior
Re : Macro recherche des valeurs présentes dans colone

Je vais essayer de modifier la MACRO afin que ca s'affiche dans une cellule EXCEL et non dans un MSGBOX. C'est assez facilement modifiable ca.

J'espère que ca ira plus vite lol
 
Vote positif 0 Vote négatif
L

laetitia90

XLDnaute Barbatruc
Re : Macro recherche des valeurs présentes dans colone

bonjour Fab57330 , Papou:):)
pour eviter une boucle on peut utiliser join

Code: 
Set Tablo = CreateObject("Scripting.dictionary")
 For sh = 1 To 3
 With Sheets(sh)
 For Each cel In .Range("E:E").SpecialCells(xlCellTypeConstants)
 If Not Tablo.Exists(cel.Value) Then Tablo.Add cel.Value, cel.Value
 Next
 End With
 Next
 MsgBox Join(Tablo.Items, " , ")
 [f2] = Join(Tablo.Items, " , ") 'ecrire dans cell

autrement vu le nombre de cells tous passer par un tablo redim preserve ect...
eventuellement utiliser Dictionary directement ....dans certains cas on gagne en vitesse ...
mais dans ce cas la il faut activer la référence "Microsoft Scripting Runtime"


Dim tablo As Dictionary
Code: 
Set tablo = New Dictionary

a la place de

Dim tablo As object
Code: 
Set Tablo = CreateObject("Scripting.dictionary")

mais bon perso plus le temps de construire cela :(:(
 
Vote positif 0 Vote négatif
L

laetitia90

XLDnaute Barbatruc
Re : Macro recherche des valeurs présentes dans colone

re, tous :):):):)
une facon de l'ecrire basique

Code: 
Sub es()
Dim t(), m As Object, i As Long, Ws As Worksheet
 Application.ScreenUpdating = False
 Set m = CreateObject("Scripting.Dictionary")
 For Each Ws In Sheets(Array("Feuil1", "Feuil2", "Feuil3"))
 With Ws
 t = .Range("e1", .Cells(Rows.Count, "e").End(xlUp)).Value
 For i = 1 To UBound(t)
 If Not m.Exists(t(i, 1)) Then m.Add t(i, 1), t(i, 1)
 Next i
 End With
 Next Ws
 [f2] = Join(m.Items, " , ")
End Sub

temps a peu pres depend des pc 5 secondes sur 3 millions de cell

en passant par Dictionary direct

Code: 
Sub ess()
Dim t(), m As Dictionary, i As Long, Ws As Worksheet
 Application.ScreenUpdating = False
 Set m = New Dictionary
 For Each Ws In Sheets(Array("Feuil1", "Feuil2", "Feuil3"))
 With Ws
 t = .Range("e1", .Cells(Rows.Count, "e").End(xlUp)).Value
 For i = 1 To UBound(t)
 If Not m.Exists(t(i, 1)) Then m.Add t(i, 1), t(i, 1)
 Next i
 End With
 Next Ws
 [f2] = Join(m.Items, " , ")
End Sub

la on passe a 1.5 secondes sur 3 millions de cell

attention tester dans cette exemple bien precis donc au max 100 données de 0 a 99

Sur chaque feuille, colonne "E", et ce sur n lignes (tout dépend du nombre de données que j'ai), des chiffres variant entre 0 et 99.
Cliquez pour agrandir...

pour activer la référence "Microsoft Scripting Runtime" on peut le faire par code

Code: 
Sub runtime()
On Error Resume Next
ThisWorkbook.VBProject.References.AddFromFile "C:\Windows\System32\scrrun.dll"
ThisWorkbook.VBProject.References.AddFromFile "C:\Windows\SysWOW64\scrrun.dll"
'ess pour lancer la macro ess
End Sub
attention on peut pas mettre le code dans la macro runtime... pas marcher.... par contre on peut l'appeler call ou sans call.... jamais compris pourquoi d'ailleurs ????

pas regarde avec redim ou redim preserve plus envie de" bosser":):):):)

on peut s'interesser au filtre.... la on va aller encore plus vite surtout que tu dois utiliser 2007 ou 2010 plus facile a construire
 
Vote positif 0 Vote négatif
F

Fab57330

XLDnaute Junior
Re : Macro recherche des valeurs présentes dans colone

Bonsoir,

La seconde méthode me plait bien. Effectivement, je n'aurai pas plus de 100 valeurs (en théorie je devrais en avoir même mois de 20... Cependant, etalées sur 3millions de lignes, et ce répétées n fois, d'ou la MACRO lol).

Je teste ca dans la semaine (car je ne suis pas sur le bon PC), et je vous tiens informé de l'issue.

Merci encore,
Fab.
 
Vote positif 0 Vote négatif
F

Fab57330

XLDnaute Junior
Re : Macro recherche des valeurs présentes dans colone

Bonsoir,
Finalement je viens de tester sur le PC la lol.
Ca ne fonctionne pas (le cas 2).

J'ai créé un nouveau modile, dans lequel j'ai mis :

Code: 
Sub ess()
Dim t(), m As Dictionary, i As Long, Ws As Worksheet
 Application.ScreenUpdating = False
 Set m = New Dictionary
 For Each Ws In Sheets(Array("Feuil1", "Feuil2", "Feuil3"))
 With Ws
 t = .Range("e1", .Cells(Rows.Count, "e").End(xlUp)).Value
 For i = 1 To UBound(t)
 If Not m.Exists(t(i, 1)) Then m.Add t(i, 1), t(i, 1)
 Next i
 End With
 Next Ws
 [f2] = Join(m.Items, " , ")
End Sub

Et ca surligne en jaune " m As Dictionary"

Une idée ?
 
Vote positif 0 Vote négatif
L

laetitia90

XLDnaute Barbatruc
Re : Macro recherche des valeurs présentes dans colone

re,:):):):)
tu as pas activer la réference "Microsoft Scripting Runtime"
en lancer la macro runtime cela devrait l'installer ???

autrement tu vas dans vba
tu click sur outils dans le bandeau en haut puis réferences tu cherches "Microsoft Scripting Runtime" la tu la coches
puis click sur le bouton ok cela devrait marcher!!!
 
Vote positif 0 Vote négatif
F

Fab57330

XLDnaute Junior
Re : Macro recherche des valeurs présentes dans colone

Et une macro qui active tout seul RUNTIME? lol.

Car il sera difficile de mettre dans le "mode opératoire" ce qu'il faut faire en plus, déja que les personnes savent tout juste lancer EXCEL (lol)
 
Vote positif 0 Vote négatif
L

laetitia90

XLDnaute Barbatruc
Re : Macro recherche des valeurs présentes dans colone

re tous:):):):):)

en regle génerale un fois active dans le fichier elle le reste!!!
je sais pas bien ce que tu fais.... tu bosses sur plusieurs pc en reseau ??? quel windows 32 bits ou 64 bits quel excel ect...
tu appel ta macro avec un bouton ???
enfin déja je voudrais savoir si cela marche!!!

aprés plusieurs possibilitées s'ouvre a toi

on peut trés bien mettre la macro runtime dans thisWorkbook

Code: 
Private Sub Workbook_Open()
On Error Resume Next
ThisWorkbook.VBProject.References.AddFromFile "C:\Windows\System32\scrrun.dll"
ThisWorkbook.VBProject.References.AddFromFile "C:\Windows\SysWOW64\scrrun.dll"
End Sub

tu remarques que je mets les 2 lignes une correspond au 32 bits l'autre au system 64 bits vu que je sais pas sur quoi tu bosses

une autre methode 2 macros

Code: 
Sub runtime()
On Error Resume Next
ThisWorkbook.VBProject.References.AddFromFile "C:\Windows\System32\scrrun.dll"
ThisWorkbook.VBProject.References.AddFromFile "C:\Windows\SysWOW64\scrrun.dll"
Call ess 'appel macro ess
End Sub

puis pareil

Code: 
Sub ess()
Dim t(), m As Dictionary, i As Long, Ws As Worksheet
 Application.ScreenUpdating = False
 Set m = New Dictionary
 For Each Ws In Sheets(Array("Feuil1", "Feuil2", "Feuil3"))
 With Ws
 t = .Range("e1", .Cells(Rows.Count, "e").End(xlUp)).Value
 For i = 1 To UBound(t)
 If Not m.Exists(t(i, 1)) Then m.Add t(i, 1), t(i, 1)
 Next i
 End With
 Next Ws
 [f2] = Join(m.Items, " , ")
End Sub


la macro runtime tu la nomme comme tu veus
si appel macro pas par un bouton on peut cacher la macro ess
avec
Code: 
Option Private Module
en debut du module comme cela 2 modules
ou plus simple
Sub ess(Optional x As String) dans ce cas on voit pas la macro ess
mais sans plus d'infos pas simple ...
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

N
  • Question
Microsoft 365 Aide adaptation d'une macro
Réponses
2
Affichages
119
netparty
N
G
  • Question
Microsoft 365 Export données d'une listview
Réponses
5
Affichages
228
GClaire
G
Akortys
  • Question
Microsoft 365 RESOLU - Macro - Recherche de lignes identiques et ressortir les lignes uniques
Réponses
2
Affichages
260
Akortys
Akortys
C
  • Question
XL 2013 Userform ne fonctionne pas s'il manque des Numéros de liste
Réponses
9
Affichages
343
candido57
C
C
  • Résolu(e)
XL 2013 Insérer des lignes
Réponses
5
Affichages
332
candido57
C
T
  • Question
XL 2021 Recherche nombre
Réponses
6
Affichages
460
Tsegp
T
G
  • Question
Microsoft 365 Incompatibilité de type - Array
Réponses
2
Affichages
238
guiyom
G
S
  • Question
XL 2016 Nombre de facture close
Réponses
11
Affichages
188
JHA
J
W
  • Question
remplacer des valeurs dans un grand tableau
Réponses
10
Affichages
313
warden
W
klin89
  • Résolu(e)
Microsoft 365 Affecter des valeurs à 2 variables tableau en comparant 2 séquences d'éléments pour remplir une colonne
2 3 4
Réponses
50
Affichages
3 K
RyuAutodidacte
RyuAutodidacte

Membres actuellement en ligne

4 membres et 57 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 370
Messages
2 087 693
Membres
103 641
dernier inscrit
anouarkecita2