Problème pour instaurer une boucle dans un algorithme

[Guiiggs]

Bonjour,

Voilà mon problème : j'ai 2 algorithmes pratiquement identiques. Je souhaite avoir un seul algorithmes (en rajoutant une boucle FOR mais celle-ci ne marche pas). Les données en rouge sont celles qui changent pour chaque algorithme.
J'ai mis que 2 algorithme mais j'en ai plus de 250 alors je souhaiterai ajouter une BOUCLE pour n'en avoir qu'un

Sub Tirage_Alternatif_D1()

Dim Don As Worksheet, Tabl As Worksheet, LastLine As Long, Test As Boolean
Application.ScreenUpdating = False
Set Don = ThisWorkbook.Worksheets("Données_Emploi")
Set Tabl = ThisWorkbook.Worksheets("Panel_Emploi")
Tabl.Select
Range("A3:A1048570").ClearContents 'Cette action ne doit être fait qu'une seule fois au début

LastLine = Don.Cells(1048570, 1).End(xlUp).Row
N = Tabl.Cells(2, 7)
If N > LastLine - 1 Then
MsgBox ("Attention plus de Données_Emploi à tirer qu'existantes")
Exit Sub
End If
For i = 1 To N
Do
Test = True
x = Int(Rnd() * (LastLine - 1) + 2)
For j = 3 To i + 2
If Tabl.Cells(j, 1) = Don.Cells(x, 1) Then Test = False
Next j
Loop While Test = False
For k = 1 To 1
Tabl.Cells(i + 2, k) = Don.Cells(x, k)
Next k
Next i
Application.ScreenUpdating = False
End Sub

-----------------------------------------------------------------------------------------------------------------

Sub Tirage_Alternatif_D2()

Dim Don As Worksheet, Tabl As Worksheet, LastLine As Long, Test As Boolean, Fin As Long
Application.ScreenUpdating = False
Set Don = ThisWorkbook.Worksheets("Données_Emploi")
Set Tabl = ThisWorkbook.Worksheets("Panel_Emploi")
Tabl.Select
LastLine = Don.Cells(1048570, 2).End(xlUp).Row
N = Tabl.Cells(3, 7)
If N > LastLine - 1 Then
MsgBox ("Attention plus de Données_Emploi à tirer qu'existantes")
Exit Sub
End If
For i = 1 To N
Fin = Tabl.Cells(1048570, 1).End(xlUp).Row
Do
Test = True
x = Int(Rnd() * (LastLine - 1) + 2)
For j = 3 To Fin + 1
If Tabl.Cells(j, 1) = Don.Cells(x, 2) Then Test = False
Next j
Loop While Test = False
''a =
For k = 1 To 1
Tabl.Cells(Fin + 1, k) = Don.Cells(x, k+1)
Next k
Next i
Application.ScreenUpdating = False

End Sub

 

[Pierrot93]

Re : Problème pour instaurer une boucle dans un algorithme

Bonjour,

regarde dans l'aide vba l'instruction "For", devrait faire l'affaire.... difficile de t'aider plus avec un bout de code jeté sur un post....

bon après midi
@+

 

[Guiiggs]

Re : Problème pour instaurer une boucle dans un algorithme

Voilà le fichier.

Mon problème est que pour les macros "Tirage" et "recopie" !! J'ai plusieurs fois le même algorithme (pour chaque macro) et je souhaite ajouter une BOUCLE FOR pour n'avoir qu'un Algorithme par macro.
Mais lorsque j'ajoute la BOUCLE FOR, elle ne fonctionne pas.

Pourriez-vous m'aider ?!

Cordialement,
Guiiggs