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
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