Sélection aléatoire sans reprendre la même donnée

Bonjour

Je vous écris pour solliciter votre aide.

J'ai des données en cellules A1 : C6.

Et je souhaite copier 3 lignes aléatoirement en cellule i1 i2 i3.

Sauf que mon problème c'est que je me retrouve avec des doublons.

Voici mon code :

Sub Hasard()

Dim lngMinL As Long

Dim lngMaxL As Long

Dim lngMinC As Long

Dim lngMaxC As Long

Dim lngAleaL As Long

Dim i As Integer

For i = 1 To 3

    Sheets("Test").Select

    Range("A1:C5").Select

    ' num de la première ligne

    lngMinL = Selection.Rows(1).Row

    ' num de la dernière ligne

    lngMaxL = Selection.Rows.Count + lngMinL - 1

    ' num de la première colonne

    lngMinL = Selection.Columns(1).Column

    ' num de la dernière colonne

   lngMaxC = Selection.Columns.Count + lngMinC - 1

    ' tirage aléatoire pour la ligne

    lngAleaL = (lngMaxL - lngMinL) * Rnd() + lngMinL

    ' selection de la cellule

    Range(Cells(lngAleaL, 1), Cells(lngAleaL, 3)).Select

    ' copie de la cellule

    Selection.Copy

    Range("I" & i).Select

    ActiveSheet.Paste

Next i

End Sub

Je n'ai pas trouvé de solution pr éviter ce problème

Merci pour votre temps .

Bonjour Loumie,

bon, on va oublier ton code, hein!?

Tu veux copier aléatoirement 3 lignes ou 3 cellules?

Qu'y aura-t-il derrière que tu ne nous dis pas?

A+

Il est si mauvais que ça le code ? lol

En faite c'est 3 lignes que je souhaite récupérer.

Et il y a deux conditions qui s'ajoutent : la cellule Ai doit être supérieure à 154 et la cellule Ci doit être égale à FN.

Salut Loumie,

Ai, je peux encore interpréter mais FN...

T'aurais t'y pas un ch'ti fichier, en plus d'explications?

A+

Oui bien sur j'ai un extrait de fichier.

FN c'est une donnée de ma ligne il faut qu'elley soit pour pouvoir séléctionner cette ligne.

Je ne sais pas si je suis assez claire

Je regarde ça dans la soirée...

A+

Ok. Merci. C'est super gentil.

Bonsoir Loumie,

voici, en cliquant sur [A1] pour démarrer la macro!

Comme souvent, dans ce genre de boucle (DO...LOOP), je mets une "sécurité" (iFlag1) qui permet une sortie de boucle en cas de conditions irréalisables, sécurité que tu peux enlever, bien sûr, si tu es certaine que tes propres critères seront toujours rencontrés!

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
Dim tTab
'
If Target.Address = [A1].Address Then
    Application.EnableEvents = False
    '
    iRow = Cells(Rows.Count, 1).End(xlUp).Row
    tTab = Range("A2:C" & iRow)
    Range("I1:K3").ClearContents
    '
    Do
        iFlag = Int(Rnd * UBound(tTab, 1)) + 1
        If tTab(iFlag, 1) > 154 And tTab(iFlag, 3) = "FN" Then
            tTab(iFlag, 1) = 0
            iLig = iLig + 1
            Range("I" & iLig & ":K" & iLig).Value = Range("A" & iFlag + 1 & ":C" & iFlag + 1).Value
        End If
        iFlag1 = iFlag1 + 1
    Loop Until iLig = 3 Or iFlag1 = 30000
    '
    Application.EnableEvents = True
End If
'
End Sub

A+

Merci : )

Perfecto

Par contre une question technique si je veux changer de cellule pr lancer la macro D1 au lieu de A1 comment puis je faire pour verrouiller la cellule comme tu l'as fait.

Merci à toi.

Salut Loumie,

qu'appelles-tu 'verrouiller' ?

If Target.Address = [D1].Address Then

A+

Autant pour moi c'est une question sans avoir fait un test au préalable.

Encore une fois merci pour ton aide.

Bonjour,

Je reviens vers vous car j'ai rencontré un problème.

En effet, j'ai modifié la macro pour que je puisse l'activer en cliquant sur un bouton sauf que les valeurs renvoyées ne respectent pas ma condition if.

Ci-joint un extrait du fichier

Sub Date_exclus()
'
Dim tTab
'
fm_MsgBoxINPUT.Show
'
 iRow = Cells(Rows.Count, 1).End(xlUp).Row
 tTab = Range("A5:H" & iRow)
 '
 Do
 iFlag = Int(Rnd * UBound(tTab, 1)) + 1
 If Mid(tTab(iFlag, 1), 2, 2) > Range("K1") And Mid(tTab(iFlag, 1), 4, 2) > Range("K2") And tTab(iFlag, 8) = "FN " Then
 tTab(iFlag, 1) = 0
 iLig = iLig + 1
 Sheets("Feuil2").Range("A" & iLig & ":H" & iLig).Value = Range("A" & iFlag + 1 & ":H" & iFlag + 1).Value
 End If
 iFlag1 = iFlag1 + 1
 Loop Until iLig = 83 Or iFlag1 = 30000
 '
End Sub

Merci pour votre aide...

J'ai beau retourner la macro dans tous les sens je ne comprend pas pourquoi elle ne sélectionne pas les données en fonction des conditions.

Merci pour votre aide .

Salut Loumie,

quand tu changes un iota à ta feuille de données, il faut adapter CHAQUE ligne de ton code!

Je te laisse jouer au jeu des 7 erreurs!

Sub Date_exclus()
'
Dim tTab
'
fm_MsgBoxINPUT.Show
'
Worksheets("Feuil2").UsedRange.Delete
With Worksheets("Feuil1")
   iRow = .Cells(Rows.Count, 1).End(xlUp).Row
   tTab = .Range("A5:H" & iRow)
    '
   Do
        iFlag = Int(Rnd * UBound(tTab, 1)) + 1
        If Val(Mid(tTab(iFlag, 7), 1, 4)) > Cells(1, 11) And Val(Mid(tTab(iFlag, 7), 5, 2)) > Cells(2, 11) And Trim(tTab(iFlag, 8)) = "FN" Then
           tTab(iFlag, 7) = 0
           iLig = iLig + 1
           Sheets("Feuil2").Range("A" & iLig & ":H" & iLig).Value = .Range("A" & iFlag + 4 & ":H" & iFlag + 4).Value
       End If
        iFlag1 = iFlag1 + 1
    Loop Until iLig = 83 Or iFlag1 = 30000
End With
    '
End Sub

A+

hey hey j'aime beaucoup ce jeu et j'ai détecté tes petits pièges :p

merciiiiiiiiiiiiiiiiiii beaucoup pour ton aide.

A+