Discussion :

[zicisis]

Bonsoir a tous
le code fonctionne mais génère une série de valeur en double
je souhaiterais une modification du code pour qu'il puisse comparer les tirages précédent , généré par ce code et si il trouve une liste identique , il ne l’écris pas et recommence son cycle définie en cellule U8
merci pour votre aide
jean

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
Sub Bouton1_Cliquer()
 
Dim BOUCLE As Integer
Dim SL, ar, i As Integer
    NB = (Range("u6") - 1)
 
   For BOUCLE = 1 To (Range("u8"))
 
   'Nombre de valeurs aléatoire à tirer
 
   ar = Range("A1", Range("A" & Rows.Count).End(xlUp))
   Set SL = CreateObject("System.Collections.SortedList")
   Randomize
   For i = 1 To UBound(ar, 1)
      If Not SL.containsvalue(ar(i, 1)) Then SL.Add Rnd, ar(i, 1)
   Next i
   With ActiveSheet
      .Cells(1, 3).CurrentRegion.Clear
      For i = 0 To Application.Min(SL.Count - 1, NB)
         .Cells(i + 1, 3).Value = SL.GetByIndex(i)
      Next i
   End With
 
   'COPIE AVEC TRI ORDRE NUMERIQUE
 
    Range("c1:c10").Select
    Selection.Copy
    Range("d20").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("TIRAGE AU SORT ").Sort.SortFields. _
        Clear
    ActiveWorkbook.Worksheets("TIRAGE AU SORT ").Sort.SortFields. _
        Add Key:=Range("d20:m20"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("TIRAGE AU SORT ").Sort
        .SetRange Range("d20:m20")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
         Range("D20:M20").Select
    Selection.Copy
      Range("AJ" & BOUCLE & ":AS" & BOUCLE).Select 'recopie avec incrementation d'une ligne x20 fois
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
                End With
                Next BOUCLE
                 TRIER RESULTAT Macro
        '
    Range("AJ1:AS100").Select
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("TIRAGE AU SORT ").Sort.SortFields. _
        Clear
    ActiveWorkbook.Worksheets("TIRAGE AU SORT ").Sort.SortFields. _
        Add Key:=Range("AJ1:AJ20"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("TIRAGE AU SORT ").Sort
        .SetRange Range("AJ1:AS100")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
           End With
 ' TRIER la liste generée
 
    Columns("AJ:AS").Select
    ActiveWorkbook.Worksheets("TIRAGE AU SORT ").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("TIRAGE AU SORT ").Sort.SortFields.Add Key _
        :=Range("AJ1:AJ10000"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("TIRAGE AU SORT ").Sort.SortFields.Add Key _
        :=Range("AK1:AK10000"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("TIRAGE AU SORT ").Sort.SortFields.Add Key _
        :=Range("AL1:AL10000"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("TIRAGE AU SORT ").Sort.SortFields.Add Key _
        :=Range("AM1:AM10000"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("TIRAGE AU SORT ").Sort
        .SetRange Range("AJ1:AS10000")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

[kiki29]

Salut, jette un œil ici : La gestion des doublons dans Excel

[zicisis]

merci a toi Kiki29 , je sentais le truc impossible vu le nombre de réponse
L'espoir vient de renaître
Merci encore
jean

[Marc-L]

Bonjour,

en dehors d'une présentation indigne, souvent quand il n'y a pas de réponse,
c'est parce qu'il y en a déjà dans la FAQ ou les tutoriels …

Qui plus est t'as dû en mettre de travers quelques uns en joignant directement une pièce jointe !
Sans compter l'horaire tardif, t'as tout d'un drôle toi ‼ L'usage étant de patienter 24 heures …


__________________________________________________________________________________________________
Tous unis, tous Charlie