IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Tirage aléatoire code


Sujet :

Macros et VBA Excel

Mode arborescent

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Futur Membre du Club
    Homme Profil pro
    sans
    Inscrit en
    Janvier 2015
    Messages
    3
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations professionnelles :
    Activité : sans

    Informations forums :
    Inscription : Janvier 2015
    Messages : 3
    Par défaut Tirage aléatoire code
    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
    Pièces jointes en attente de validation Pièces jointes en attente de validation

Discussions similaires

  1. Pipé un tirage aléatoire
    Par uloaccess dans le forum Access
    Réponses: 4
    Dernier message: 03/07/2006, 16h45
  2. Tirage Aléatoire unique ..
    Par FoX_McClouD dans le forum Requêtes
    Réponses: 2
    Dernier message: 13/06/2006, 13h48
  3. tirage aléatoire
    Par uloaccess dans le forum Access
    Réponses: 10
    Dernier message: 22/02/2006, 18h02
  4. Tirage aléatoire dans une base donnée
    Par leloup84 dans le forum SQL Procédural
    Réponses: 4
    Dernier message: 30/01/2006, 16h13
  5. Eviter deux nombres identiques dans un tirage aléatoire
    Par moon tiger dans le forum Pascal
    Réponses: 5
    Dernier message: 25/11/2002, 09h57

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo