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

[julie211]

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

 

[job75]

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

Bonjour Jean-Marie,

Tu as très bien compris, et j'avais bien pensé à RemoveDuplicates.

Le problème c'est que quand on supprime les doublons d'une colonne les autres colonnes du tableau ne suivent pas.

C'est facile de le tester.

Pour ce qui est de la boîte de dialogue, il est clair qu'elle ne suit pas complètement ce que fait VBA.

A+

 

[laetitia90]

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

bonjour tous
une autre facon de l'ecrire...... enfin si j'ai bien compris !!!!

 

[Staple1600]

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

re, bonjour leti


Job75
Si on utilise RemoveDuplicates en sélectionnant tout le tableau, cela change la donne ou pas ?

ActiveSheet.Range("$C$1:$P$799").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, _
        7, 8, 9, 10, 11, 12, 13, 14), Header:=xlYes

PS: J'ai pas eu le courage de vérifier si il y a suppression de la ligne entière ou pas

 

[job75]

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

Bonjour Laetitia,

Ton code permet de ne pas tirer 2 fois la même ligne, c'est évidemment simple s'il n'y a pas de doublon en colonne K.

Mais Bebere et moi avons compris, peut-être à tord, qu'il pouvait y en avoir.

A+

 

[Bebere]

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

bonjour Julie,Job,Staple,Laetitia
une autre version avec tirage
testé sur 300

 

[Staple1600]

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

Re, Bonjour Bebere


Job75
J'essaie juste de savoir si on peut faire strictement la même chose avec RemoveDuplicate qu'avec Filtre élaboré Extraction sans doublons coché.
D’après tes réponses, j'en déduis que c'est non, non ?

 

[job75]

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

Re,

S'il n'y a jamais de doublon en colonne K ma macro du post #12 se simplifie :

Sub TiragesAléatoires()
Dim n&, derlig&, P As Range
n = 300 '1000 'nombre de lignes à retenir, à adapter
Application.ScreenUpdating = False
derlig = ActiveSheet.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row
With Feuil2 'CodeName de la feuille de restitution
  .Rows("4:" & .Rows.Count).Delete 'RAZ
  ActiveSheet.Rows("4:" & derlig).Copy .[A4]
  Set P = Intersect(.UsedRange, .Rows("4:" & derlig))
  With P.Columns(P.Columns.Count + 1) 'colonne auxiliaire à droite
    .Formula = "=RAND()"
    .Value = .Value 'supprime les formules
    .Cells(1) = 0
    Union(P, .Cells).Sort .Cells, xlAscending 'tri
    .EntireColumn.Delete 'suppression de la colonne auxiliaire
  End With
  .Rows(n + 5 & ":" & .Rows.Count).Delete
  n = .UsedRange.Rows.Count 'ajuste la barre de défilement verticale
  .Columns.AutoFit 'ajustement de la largeur des colonnes
  .Activate
End With
End Sub

Fichier (3).

Sur 200000 lignes la macro s'exécute en 4,7 secondes.

PS pour JM : tu n'as qu'à tester ce que tu veux faire.

Edit : attention le fichier (3) est en mode de calcul manuel

Je viens de m'en rendre compte en le rouvrant pour rédiger mon post #50.

A+

 

[Staple1600]

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

Re

Job75
Très bon conseil
J'ai donc testé (sur une feuille vierge)
sauf erreur de ma part, les lignes suivent lors de la suppression des doublons, non ?

Sub test()
a
MsgBox "pause"
a "B2:J13,L2:P13"
End Sub

Private Sub a(Optional vide$ = "Z1")
[A1] = "ITEM1": [A1].AutoFill Destination:=Range("A1:P1"), Type:=xlFillDefault
With Range("A2:A13")
    .Value = Application.Transpose(Array(1, 2, 3, 4, 4, 4, 4, 6, 7, 8, 9, 10))
    .AutoFill Destination:=Range("A2:P13"), Type:=xlFillDefault
End With
Range(vide) = Empty
MsgBox "Test RemoveDuplicates"
ActiveSheet.Range("$A$1:$P$13").RemoveDuplicates Columns:=11, Header:=xlYes
End Sub

 

[KenDev]

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

Bonjour Julie, Laetitia, Bebere, Job, Staple...

Une comparaison des trois codes : Job75 post n°22, laetitia90_post n°17, KD post n°13 (2ème code). Ces codes sont adaptés à la présentation du fichier exemple fourni au post n°7, c'est pourquoi n'est pas inclus le code Bebere du post n°20. Trois mesures à chaque fois en variant l'ordre des procédures. BDD 203.951 lignes.

Ces trois codes partent du principe que le 'sans doublons' demandé correspond au tirage et que la BDD ne contient pas de doublons. Si la BDD contient des doublons se reporter à Job post n°14.

échantillon demandé 300:
n°22: 5, 5, 5 secondes
n°17: 3, 4, 3 secondes
n°13: 2, 1, 2 secondes

échantillon demandé 1000
n°22: 04, 05, 05 secondes
n°17: 10, 12, 12 secondes
n°13: 02, 01, 02 secondes

échantillon demandé 5000
n°22: 05, 04, 05 secondes
n°17: 58, 60, 58 secondes
n°13: 05, 05, 04 secondes

échantillon demandé 10000 (abandon test n°17).
n°22: 05, 05 secondes
n°13: 07, 08 secondes

Le code de Job75 est remarquablement stable quelque soit la taille de l'échantillon. Toutefois si les échantillons sont toujours nettement inférieur à 5000 il semblerait que le code du n°13 soit plus rapide.

Cordialement
KD

 

[job75]

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

Re Jean-Marie,

Tu as gagné, avec cette instruction :

P.RemoveDuplicates Columns:=11, Header:=xlYes

toutes les colonnes suivent bien

Et sur 200000 lignes (797 valeurs uniques en colonne K) la macro du post #12 s'exécute en 9,8 secondes.

C'est quand même moins rapide qu'avec le tableau VBA du post #14 (6,8 secondes).

A+

 

[Bebere]

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

bonjour KenDev
code adapté au classeur poste7

 

[KenDev]

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

@Bebere,

Il aurait été dommage en effet de passer à coté! Testé dans les mêmes conditions :

échantillon demandé 300:
n°22: 5, 5, 5 secondes
n°17: 3, 4, 3 secondes
n°13: 2, 1, 2 secondes
n°26: 1, 1, 1 secondes

échantillon demandé 1000
n°22: 04, 05, 05 secondes
n°17: 10, 12, 12 secondes
n°13: 02, 01, 02 secondes
n°26: 01, 00, 01 seconde

échantillon demandé 5000
n°22: 05, 04, 05 secondes
n°17: 58, 60, 58 secondes
n°13: 05, 05, 04 secondes
n°26: 02, 01, 01 secondes

échantillon demandé 10000
n°22: 05, 05 secondes
n°13: 07, 08 secondes
n°26: 02, 02, 02 secondes

Ton code est de loin le plus rapide pour toutes les tailles d'échantillons.

J'ai revu mon code en tablant dès le premier passage et en restituant également avec transpose en espérant être plus rapide, puisque pas d'objets dictionary, j'obtiens :
E(300): Bebere 1s & 1s, KD 1s & 1s
E(1000): Bebere 1s & 1s, KD 1s & 1s
E(5000): Bebere 1s & 1s, KD 2s & 2s
E(10000): Bebere 1s & 2s, KD 3s & 2s
E(20000): Bebere 4s & 3s, KD 3s & 4s
E(50000): Bebere 14s & 13s, KD 8s & 8s

Il semblerait que ton code reste plus rapide pour des petits échantillons et le mien pour des gros. Ceci dit Julie souhaite des échantillons d'ordre de grandeur 1000 pas 50000...
Je poste quand même au cas ou il y aurait impossibilité d'activer Scripting.Runtime.

Cordialement
KD

Sub Echantillon2()
    Dim r&, a$(), p#, i&, c&, b&, d%, w As Worksheet, e%, j%, n&
    Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
    Worksheets("BDD").Activate
    b = 4: d = 11: n = 300                               'ligne de titres/colonne sans éléments vides/nb de dossiers demandés
    r = Cells(Rows.Count, d).End(xlUp).Row - b
    e = Cells(b, Columns.Count).End(xlToLeft).Column     'pas d'intitulés de colonnes vides
    If n > r Then Exit Sub
    ReDim a(1 To n, 1 To e): p = n / r: Randomize
    For i = 1 To r - 1
        If Not Rnd > p Then
            c = c + 1: n = n - 1
            For j = 1 To e: a(c, j) = Cells(i + b, j): Next j
        End If
        p = n / (r - i)
    Next i
    If n = 1 Then a(UBound(a)) = r
    Set w = ActiveSheet: Sheets.Add: w.Cells.Copy Destination:=[A1]
    Range(Cells(b + 1, 1), Cells(Rows.Count, Columns.Count)).ClearContents
    Cells(b + 1, 1).Resize(UBound(a), e) = a
    Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End Sub

 

[Staple1600]

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

Bonsoir à tous

Je poste quand même au cas ou il y aurait impossibilité d'activer Scripting.Runtime.

Pour éviter les problèmes lié à la référence Scripting.Runtime.
On peut modifier le code de Bebere ainsi pour ne pas avoir à cocher la référence
(sur ces deux lignes, faire les modifs ci-dessous)
Dim dico As Object, mondico As Object
puis
Set mondico = CreateObject("Scripting.dictionary")

PS: L'avantage du code de Kendev c'est qu'il fonctionne sous Windows et Mac, celui de Bebere uniquement sous Windows.

 

[Bebere]

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

sur le site de JB tu trouveras du code pour adapter dictionary à Mac

Sub AjoutRéfScripting()
ActiveWorkbook.VBProject.References.AddFromFile "C:\WINDOWS\System32\scrrun.dll"
End Sub

 

[Staple1600]

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

Re

Bebere
En utilisant
Set mondico = CreateObject("Scripting.dictionary")
Pas besoin de référence cochée vers scrrun.dll

PS:
Précision (au cas où)
Mon message précédent n'était pas une critique de ton code.
Simplement un complément d'information