Extraction ligne tirage LOTO

NICOALBERT · 3 Août 2016

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 .

Yurperqod · 3 Août 2016

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 · 3 Août 2016

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 · 3 Août 2016

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 · 3 Août 2016

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

NICOALBERT · 3 Août 2016

Bonjour Hieu ,

Merci pour ce code c'est tout à fait cela , c'est nickel , un grand merci .
Est ce que c'est possible la même chose avec plusieurs n° ou pas .

Exemple je sélectionne deux ou trois n° par exemple .

Yurperqod · 3 Août 2016

Il faut changer le numéro dans cette ligne
If Application.WorksheetFunction.CountIf(Plage, 1) = 1 Then
par exemple si on cherche pour le numéro 5
If Application.WorksheetFunction.CountIf(Plage, 5) = 1

Hieu · 3 Août 2016

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

NICOALBERT · 3 Août 2016

Un grand merci à Hieu et à Yurperqod .

Extraction ligne tirage LOTO

NICOALBERT

XLDnaute Occasionnel

Pièces jointes

Yurperqod

XLDnaute Occasionnel

Yurperqod

XLDnaute Occasionnel

NICOALBERT

XLDnaute Occasionnel

Hieu

XLDnaute Impliqué

Pièces jointes

NICOALBERT

XLDnaute Occasionnel

Yurperqod

XLDnaute Occasionnel

Hieu

XLDnaute Impliqué

Pièces jointes

NICOALBERT

XLDnaute Occasionnel

Discussions similaires