Tirage sur un colonne sans doublons (grd base données )

julie211

XLDnaute Nouveau
Bonjour à tous,

Je suis novice en vba et je n'ai pas été capable de trouver une solution à mon problème malgré de nombreuses discussions sur le sujet.

J'ai une grande base données (plus de 100000 lignes) et je voudrais trouver un moyen de tirer aléatoirement et sans doublon un nombre variable sur une colonne (1000 par exemple) pour les travailler indépendamment dans un autre onglet en copiant les colonnes correspondants.

Je vous joint un exemple du format de ma fiche de travail: je voudrais tirer 300 dossiers sur la colonne C ( référence) aléatoire sans doublons parmi plus de 700 dossiers au total, et après copier coller dans un autre onglet ''feuil2" qui est en même format que "feuil1".

comme j'ai une grande base de donnée, il faudrait peut-être optimiser le temps de tourne le macro.

Merci d'avance pour votre aide.

Cordialement,

Julie
 

Pièces jointes

  • Classeur2.xlsx
    38.6 KB · Affichages: 88
  • Classeur2.xlsx
    38.6 KB · Affichages: 105
  • Classeur2.xlsx
    38.6 KB · Affichages: 95

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : Tirage sur un colonne sans doublons (grd base données )

Bonjour à tous :),

Bon, je m'y mets aussi, y'a pas de raison !

Un essai dans le fichier joint:

  • on peut choisir le nombre de lignes initiales
  • on peut choisir le nombre de lignes à tirer au sort
  • la source comprendra (le plus souvent) des doublons en colonnes C
  • les lignes tirées au sort le seront sans doublon en colonne C
  • le tri n'est pas ce qu'on pourrait appelé "optimisé"

Il me semble que c'est assez rapide mais comme j'ai une vieille bouse....

Préférez version v3 plus rapide ICI.

VB:
Sub tirage()
Dim tSource, tLignes()
Dim dicoTirage, elem, combien&
Dim N&, i&, m&, lequel&, aux&, t0, ech As Boolean

' initialisation
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
t0 = Timer
combien = Range("A_tirer")
Sheets("Feuil1").Activate
N = Range("c" & Rows.Count).End(xlUp).Row
If N - 3 < combien Then
  MsgBox "Nbr de référence < Nbr à tirer => ECHEC"
  Exit Sub
End If

' remplissage du tableau des n° de lignes
tSource = Range("c4.c" & N).Value
ReDim tLignes(1 To UBound(tSource))
For i = 1 To UBound(tSource): tLignes(i) = i: Next i

' remplissage aléatoire du dictionnaire sans doublons
Set dicoTirage = CreateObject("scripting.dictionary")
Randomize: m = UBound(tLignes): i = 1
Do
  lequel = i + Int(Rnd * m)
  aux = tLignes(i): tLignes(i) = tLignes(lequel): tLignes(lequel) = aux
  If Not dicoTirage.exists(tSource(tLignes(i), 1)) Then _
    dicoTirage.Add tSource(tLignes(i), 1), tLignes(i)
  i = i + 1: m = m - 1
Loop Until dicoTirage.Count = combien Or m = 0

' tri des n° de lignes retenus
Erase tLignes
tLignes = dicoTirage.items
Do
  ech = False
  For i = 0 To UBound(tLignes) - 1
    If tLignes(i + 1) < tLignes(i) Then
      aux = tLignes(i + 1): tLignes(i + 1) = tLignes(i): tLignes(i) = aux
      ech = True
    End If
  Next i
Loop Until Not ech
    
' écriture du résultats
Sheets("feuil2").Range("a4:d4").Resize(100000).Clear
m = 0
For i = 0 To UBound(tLignes)
  m = m + 1
  Range("a3").Offset(tLignes(i)).Resize(, 4).Copy _
        Sheets("feuil2").Range("a3").Offset(m).Resize(, 4)
Next i

' finalisation
Application.Goto Sheets("feuil2").Range("a1"), True
MsgBox "C'est fini ! ( " & Format(Timer - t0, "0.00") & "  sec. )" & vbLf & vbLf & _
   Format(1 + UBound(tLignes), "#,##0") & " enregistrements dictincts tirés au sort."
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
 
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : Tirage sur un colonne sans doublons (grd base données )

Bonjour à tous :),

Une version plus rapide au niveau de la copie des données de Feuil1 sur Feuil2.
VB:
Sub tirage()
Dim tSource, Nsource, tLignes()
Dim dicoTirage, elem, combien&
Dim N&, i&, m&, lequel&, aux&, t0, ech As Boolean

' initialisation
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
t0 = Timer
combien = Range("A_tirer")
Sheets("Feuil1").Activate
If ActiveSheet.AutoFilterMode Then ActiveSheet.Cells.AutoFilter
N = Range("c" & Rows.Count).End(xlUp).Row
If N - 3 < combien Then
  MsgBox "Nbr de référence < Nbr à tirer => ECHEC"
  Exit Sub
End If

' remplissage du tableau des n° de lignes
tSource = Range("c4.c" & N).Value
Nsource = UBound(tSource)
ReDim tLignes(1 To UBound(tSource))
For i = 1 To UBound(tSource): tLignes(i) = i: Next i

' remplissage aléatoire du dictionnaire sans doublons
Set dicoTirage = CreateObject("scripting.dictionary")
Randomize: m = UBound(tLignes): i = 1
Do
  lequel = i + Int(Rnd * m)
  aux = tLignes(i): tLignes(i) = tLignes(lequel): tLignes(lequel) = aux
  If Not dicoTirage.exists(tSource(tLignes(i), 1)) Then _
    dicoTirage.Add tSource(tLignes(i), 1), tLignes(i)
  i = i + 1: m = m - 1
Loop Until dicoTirage.Count = combien Or m = 0

'tableau des lignes retenues
ReDim tLignes(1 To UBound(tLignes), 1 To 1)
For Each elem In dicoTirage.keys: tLignes(dicoTirage(elem), 1) = 1: Next elem

' filtre et écriture du résultat
Range("a:a").Insert
Range("a4").Resize(UBound(tLignes)) = tLignes
Range("a3:e" & (Nsource + 1)).AutoFilter Field:=1, Criteria1:="<>"
Sheets("feuil2").Range("a4:d4").Resize(100000).Clear
Range("b3:e" & (UBound(tSource) + 1)).Copy Sheets("feuil2").Range("a3")
Range("a:a").Delete
If ActiveSheet.AutoFilterMode Then ActiveSheet.Cells.AutoFilter
  
' finalisation
Application.Goto Sheets("feuil2").Range("a1"), True
MsgBox "C'est fini ! ( " & Format(Timer - t0, "0.00") & "  sec. )" & vbLf & vbLf & _
   Format(dicoTirage.Count, "#,##0") & " enregistrements dictincts tirés au sort."
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End Sub
 

Pièces jointes

  • julie211-tirage sans doublons-v3.xlsm
    26 KB · Affichages: 46
Dernière édition:

Staple1600

XLDnaute Barbatruc
Re : Tirage sur un colonne sans doublons (grd base données )

Bonjour à tous

bonjour Staple
bien sûr mais avec Set mondico = CreateObject("Scripting.dictionary") tu perds les avantages que tu as quand tu écris ton code add,count,item,items,exist,etc
Disons que quand il s'agit de code VBA à destination de fils où le demandeur tâtonne encore avec VBA ou vient juste de découvrir le monde des macros, je préfère l'avantage de m'épargner le sempiternel
"J'ai copié le code dans mon vrai classeur mais ça ne fonctionne pas. J'ai une erreur" que ne manquera de poster le demandeur encore mal à l'aise avec son VBE.;)

Et tiens puisque je suis en mode chafouin du dimanche matin, semons des graines de volée de bois vert

[graines de volée de bois vert]
Je viens de m'apercevoir que julie n'est pas revenu dans le fil depuis un petit bail déjà.
J'ai presque l'impression que toute cette profusion de beaux codes VBA, c'est comme confire des donuts monté sur un cochon sur une autoroute espagnole.
(ou comme aurait pu dire Nadia C. sur sa barre: "A strica orzul pe gâste")
Mais au moins les fondus de la Cellule se régalent ;), et c'est déjà beaucoup.
NB: C'est vrai que nous sommes un week-end avec jour férié, me suis peut-être emballé trop vite ;
Il sera toujours temps d'éditer au retour du demandeur dans le fil ;)
[/graines de volée de bois vert]
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Re : Tirage sur un colonne sans doublons (grd base données )

Bonjour Bebere

Ma chafouinitude dominicale s'est estompée avec les effluves d'un bon café, matinée d'une bonne odeur de pain grillée sur lequel fondit une noisette de beurre salé.

Je devrais donc être parfaitement opérationnel pour faire une petite récap de toutes les propositions du fil pour voir laquelle est la moins rapide
(oui la moins rapide parce que le dimanche après le mode chafouin, il peut m'arriver de vite basculer dans ce mode-ci ;))

D'un autre côté, si un des codeurs émérites de ce fils faisait une récap qui indiquerait la procédure la plus rapide, je pourrais facilement en déduire la moins véloce ;)

Alors, y-a-t-il des amateurs pour la récap ;) ?
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : Tirage sur un colonne sans doublons (grd base données )

Bonjour Staple1600 :),

(...) Ma chafouinitude dominicale s'est estompée avec les effluves d'un bon café, matinée d'une bonne odeur de pain grillée sur lequel fondit une noisette de beurre salé (...)
P'tit Déj à 10h00, Môôônsieur se la coule douce... Pas même une petite endive trempée dans le café de si bon matin ? :D

(...) D'un autre côté, si un des codeurs (...) faisait une récap qui indiquerait la procédure la plus rapide, je pourrais facilement en déduire la moins véloce ;) (...)
Alors, y-a-t-il des amateurs pour la récap ;) ?

Bon, je vais voir ce qu'on peut faire... On est dimanche, je vais, très certainement, me hâter lentement pour trouver le plus qui va le moins lentement...

On va prendre comme base le fichier du #7 avec comme hypothèse la présence de doublons dans les références. Il va falloir que je commence par adapter mon fichier v3 qui avait pris le modèle du #1.
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Re : Tirage sur un colonne sans doublons (grd base données )

Bonjour mapomme

[perche tendue]
Bonjour Staple1600 :),
P'tit Déj à 10h00, Môôônsieur se la coule douce... Pas même une petite endive trempée dans le café de si bon matin ? :D
Un chicon dans le kawa.. hum cela sent le contrepet à plein nez, non ?
Quand à ma petite endive, mon médecin se félicite, que je la trempe matin, midi et soir.
mais je veille à respecter ce qu'il y a sur la notice de mon endive
Durée de traitement :
le patient doit être informé de ne pas utiliser son endive plus de 3 jours en cas de fièvre et de 5 jours en cas de douleurs
sans l'avis d'un médecin ou d'un dentiste.
[/perche détendue]

Merci mapomme de te coller à la tâche récapitulative ;)
 

KenDev

XLDnaute Impliqué
Re : Tirage sur un colonne sans doublons (grd base données )

Bonjour à tous les (re)-sus-cités et à mapomme,

D'un autre côté, si un des codeurs émérites de ce fils faisait une récap qui indiquerait la procédure la plus rapide, je pourrais facilement en déduire la moins véloce ;)

Alors, y-a-t-il des amateurs pour la récap ;) ?

Ahem... C'est-y pas déjà fait même si pas par émérite ? Je n'ai juste pas mis à jour avec l'excellent mapomme car ce dernier se distingue en se basant sur le post n°1 (le n°7 est celui du cas réel), et j'ai un peu la flemme de tenter de l'adapter alors qu'une odeur de coq au vin se met à flotter aux alentours...

Par ailleurs, comme vous le soulignâtes, nous sommes un week end et il est un peu tôt pour râler après Julie (et puis par principe je ne râle jamais après une Julie).

Bon dimanche!

Amicalement
KD
 

Staple1600

XLDnaute Barbatruc
Re : Tirage sur un colonne sans doublons (grd base données )

Bonjour KenDev

J'avais bien vu ta récap ;). J'aurais du préciser ce matin : une mise à jour de la récap depuis le #27
Et je parlais de joindre un fichier avec tous le différents codes depuis le début
Mais ce matin, j'étais encore dans les limbes, pas encore tout à fait réveillé
Et je ne râlais pas mais j'asticotais sur un mode plus ou moins humoristique.

[aparté]
Quant à ne jamais râler sur une Julie, je ne peux pas être entièrement d'accord avec vous
Il y a moins une Julie (voir deux) sur laquelle je me gène pas de râler
C'est Julie Lescaut (ou plutôt son interprète )
Sans oublier Julie A. qui a honteusement plagié l'émission de Sarah W.
[/aparté]


Bon appétit

Pour moi ce sera galette de sarrasin lardons chèvre et une palanquée de feuilles de roquette
Une pomme , quelques châtaignes fraiches et deux trois bolées pour faire glisser tout cela ;)

PS: En repensant à la question : je pensais à cette piste
1) Copie de l'intégralité des données (sans doublons)
puis suppression de N éléments aléatoirement pour qu'il en reste le nombre demandé

Serait-ce plus ou moins rapide que de tirer N éléments dans une liste ?

NB: KenDev : je te confirme que pour moi tu appartiens au club des Grands Pontes du Code VBA qui peuplent ce forum.
(Et je n'en suis même pas le portier ;), juste une groupie qui vous lit tous religieusement et recopie vos codes dans des petits carnets à spirales le soir venu dans un très vieil appartement rue Sarasate.) ;)
 
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : Tirage sur un colonne sans doublons (grd base données )

Bonsoir à tous :),

L'entreprise de récapitulation des codes et comparaisons s'avèrent plus difficile que prévue.

D'emblée, je n'ai pas retenu les codes qui ne travaillaient pas sur le format du fichier du post #7.
Puis, après examen des codes (de manière succincte ma foi), je ne trouve que deux codes qui enlèvent les doublons (colonne K <=> "références") dans le résultat (celui de job75 et celui de mapomme). Il y en a peut-être d'autres mais je ne les ai pas détectés.

J'ai modifié légèrement le code de job75 :eek: pour tenir compte des noms de feuilles "Source" et "Resultat", de quelques constantes et pour l'inscription du bilan dans sur la feuille "Accueil". Un commentaire indique les lignes modifiées ou ajoutées.
job75 m'informera, s'il le désire, du bien fondé ou non des modifications ou bien me reprochera la pratique éhontée et usurpatrice de modification d'un code dont je ne suis pas l'auteur :(.

Il faut d'abord initialiser les données sources.

  • indiquer dans les cellules B1 et B2, le nombres de lignes souhaitées de la source et le taux de valeurs distinctes
  • cliquez sur la forme "Init"
  • la cellule E1 indique le nombre de lignes de la source
  • la cellule E2 indique le nombre de lignes de la source avec des références distinctes

  • ...

  • indiquez ensuite le nombre de lignes à tirer au sort dans la cellule B3
  • puis cliquer sur un bouton "Tirage au sort..."
  • le bilan du tirage s'inscrit sur la feuille "Accueil"

rem 1 : l'initialisation est un peu longue pour de grandes valeurs de nombres de lignes.
rem 2 : le nombre de lignes tirées au sort peut-être inférieur au nombre souhaité en raison d'un grand nombre de doublons.
ex : on demande 30 lignes sources avec un taux faible de valeurs distinctes et on souhaite tirer au sort un nombre de lignes supérieur au nombre de valeurs distinctes ( ie supérieur à E2)
rem 3 : les données de la colonne K n'ont pas le format du fichier de julie211 (post #7). Ce n'est pas grave, les codes fonctionneront aussi avec le format de julie211.
 

Pièces jointes

  • julie211-tirage sans doublons-compar-v2.xlsm
    49.9 KB · Affichages: 56
Dernière édition:

Staple1600

XLDnaute Barbatruc
Re : Tirage sur un colonne sans doublons (grd base données )

Bonsoir à tous

mapomme
Merci pour ton labeur ;)
Sinon
la pratique éhontée et usurpatrice de modification d'un code dont je ne suis pas l'auteur
C'est comme cela qu'on tous appris le VBA, non ?
En commençant par modifier le code des exemples présents dans l'aide VBAet dont nous n'étions pas les auteurs ;)
Puis en faisant des essais plus ou moins malencontreux sur les codes que nous glanions sur le net
Une fois qu'on a su altérer le code d'autrui, nous étions prêt à pondre notre code pour ensuite lui faire subir mouts test et/ou divagations.
Tout ce compte c'est de prendre du plaisir dans l'éditeur en toujours citant l'auteur de code original.

*(Il s'en trouve peut-être à prendre du plaisir à regarder l'éditeur et l'auteur se faire du bien (comme cela à court dans certains salons parisiens), mais ceci est une autre histoire)

*: oui je sais ceci était dispensable mais je me suis fait plaisir ;)
 

KenDev

XLDnaute Impliqué
Re : Tirage sur un colonne sans doublons (grd base données )

Bonsoir à tous,

Superbe fichier très plaisant à utiliser mapomme.

Hélas je crains que nous ne sachions jamais si la liste des dossiers était avec ou sans doublons.

Cordialement

KD
 

Staple1600

XLDnaute Barbatruc
Re : Tirage sur un colonne sans doublons (grd base données )

Bonsoir à tous


KenDev:
julie est peut-être en week-end prolongé suivi de congés ;)

Sinon personne pour commenter cet idée qui me trotte dans la tête
PS: En repensant à la question : je pensais à cette piste
1) Copie de l'intégralité des données (sans doublons)
puis suppression de N éléments aléatoirement pour qu'il en reste le nombre demandé

Serait-ce plus ou moins rapide que de tirer N éléments dans une liste ?
C'est juste que j'aimerai avoir vos avis avant de tenter la chose, histoire de ne pas aller titiller VBE en vain.
 

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 943
Membres
101 849
dernier inscrit
florentMIG