Extraction ligne tirage LOTO

NICOALBERT

XLDnaute Occasionnel
Bonjour le Forum ,

J'aurais voulu savoir si il y avait la possibilité d'extraire (via une macro) les lignes de tirage du loto après le tirage d'un numéro précis .

Exemple si le N° 1 est sorti copier la ligne suivante (en vert dans l'exemple) et cela pour chaque N° 1 de la feuille "Base" Hors N° chance .

Cordialement Nicoalbert .
 

Pièces jointes

  • Extraction Tirage Loto.xls
    126.5 KB · Affichages: 142

Yurperqod

XLDnaute Occasionnel
Bonjour le forum

Un essai
VB:
Sub test()
Dim v_DL As Long, v_L As Long, Plage As Range
v_DL = Range("A" & Rows.Count).End(xlUp).Row
For v_L = 2 To v_DL
Set Plage = ActiveSheet.Range(ActiveSheet.Cells(v_L, "B"), ActiveSheet.Cells(v_L, "F"))
If Application.WorksheetFunction.CountIf(Plage, 1) = 1 Then
Plage.Offset(1).Copy Feuil2.Cells(Rows.Count, "C").End(xlUp).Offset(1, 0)
End If
Set Plage = Nothing
Next
End Sub
 

Yurperqod

XLDnaute Occasionnel
Pour avoir la date et le numéro chance
VB:
Sub testV2()
Dim v_DL As Long, v_L As Long, Plage As Range
v_DL = Range("A" & Rows.Count).End(xlUp).Row
For v_L = 2 To v_DL
Set Plage = ActiveSheet.Range(ActiveSheet.Cells(v_L, "B"), ActiveSheet.Cells(v_L, "F"))
If Application.WorksheetFunction.CountIf(Plage, 1) = 1 Then
Plage.Offset(1, -1).Resize(, 7).Copy Feuil2.Cells(Rows.Count, "C").End(xlUp).Offset(1, 0)
End If
Set Plage = Nothing
Next
End Sub
 

NICOALBERT

XLDnaute Occasionnel
Bonjour Yurperqod ,

Tout d'abord un grand merci pour le temp que tu a pris pour me répondre .

Lorsque je modifie le N° sélectionner dans la feuil2 c'est toujours la même extraction .

Peut être est ce moi qui me trompe dans la manip !!
 

Hieu

XLDnaute Impliqué
Salut,

Une idée :
VB:
Sub tirage()
Application.ScreenUpdating = False
Sheets("Extraction").Columns("b:h").Clear
num = Sheets("Extraction").Range("a3")
Set boule = Sheets("Base").Range("b1:f1")

For i = 1 To 1225
    For Each r In boule.Offset(i, 0)
        If r = num Then
        Sheets("Base").Range("a1:g1").Offset(i + 1).Copy
        Sheets("Extraction").Range("b2").Offset(k, 0).PasteSpecial
        k = k + 1
        Exit For
        End If
    Next r
Next i
End Sub
 

Pièces jointes

  • Extraction Tirage Loto_v0.xls
    158.5 KB · Affichages: 120

Hieu

XLDnaute Impliqué
Une petite modif à la va-vite :
VB:
Sub tirage()
Application.ScreenUpdating = False
Sheets("Extraction").Columns("b:h").Clear
num1 = Sheets("Extraction").Range("a3")
num2 = Sheets("Extraction").Range("a4")
Set boule = Sheets("Base").Range("b1:f1")

For i = 1 To 1225
test1 = False
test2 = False
    For Each r In boule.Offset(i, 0)
    If r = num1 Then test1 = True
    If r = num2 Then test2 = True
        If test1 And test2 = True Then
        Sheets("Base").Range("a1:g1").Offset(i + 1).Copy
        Sheets("Extraction").Range("b2").Offset(k, 0).PasteSpecial
        k = k + 1
        Exit For
        End If
    Next r
Next i
End Sub
 

Pièces jointes

  • Extraction Tirage Loto_v1.xls
    150.5 KB · Affichages: 148

Discussions similaires

Statistiques des forums

Discussions
314 422
Messages
2 109 447
Membres
110 482
dernier inscrit
ilyxxxh