Sub rechcouple()
Dim coldroite, colgauche, i, d, compt, nbr, nbrcoup As Byte
colgauche = -3

Do
coldroite = 0
colgauche = colgauche + 4
Do
compt = 0
test = False

coldroite = coldroite + 1

Windows("LOTO.XLS").Activate
Workbooks("loto.xls").Sheets("loto").Range("a1").Select

Do
For i = 1 To 6
nbr = Selection.Cells.Value
nbrcoup = Workbooks("suite.xls").Sheets("couple").Cells(coldroite, colgauche).Value
If nbr = nbrcoup Then
test = True
Else: test = False

End If
If test = True Then
' Cells(coldroite, 4).Select
Selection.End(xlToLeft).Select
For d = 1 To 6
Selection.Cells.Offset(0, 1).Select
ktest = Selection.Cells.Value
If ktest = Workbooks("suite.xls").Sheets("couple").Cells(coldroite, colgauche + 1).Value Then
compt = compt + 1
End If
Next d
GoTo décalage

End If
Selection.Cells.Offset(0, 1).Activate
Next i
décalage:
Workbooks("suite.xls").Worksheets("couple").Cells(coldroite, colgauche + 2).Value = compt
Selection.Cells.Offset(1, 0).Select
Selection.End(xlToLeft).Activate

Loop Until Selection.Cells = 0
Debug.Print "avancement : " & Workbooks("suite.xls").Worksheets("couple").Cells(coldroite, colgauche + 1).Value
Loop Until Workbooks("suite.xls").Worksheets("couple").Cells(coldroite, colgauche + 1).Value = 49
Windows("suite.XLS").Activate
Loop Until colgauche = 190
End Sub

cette macro permet de recherhcer les couples dans les tirages de la feuille LOTO,
initialisation de colgauche à -3

Sub Macro2()
'
' Macro2 Macro
k = 0
compt = 0
Dim cellule As Range

fin = Selection.End(xlDown).Row
For g = 1 To fin

selrang (g)
For Each cellule In Selection.Cells
If cellule.Value = 1 And cellule.Next.Value = 2 Then
compt = compt + 1
End If
Next

Next g

MsgBox "compt = " & compt
End Sub

Sub selrang(ligne)
Windows("LOTO.XLS").Activate
Range(Cells(ligne, 1), Cells(ligne, 6)).Select
End Sub

Public Sub miseentableau()
Dim i, j As Byte
Dim der As Integer
nbrtirage
der = Selection.End(xlDown).Row
ReDim essaitab(1 To der, 1 To 6) As Byte
For i = 1 To der
For j = 1 To 6
essaitab(i, j) = Cells(i, j).Value
Next j
Next i
Debug.Print " mise en tableau terminée"
End Sub

Sub nbrtirage()
Dim classloto As Workbook
Set classloto = GetObject("f:\loto.xls")
Windows("loto.xls").Activate
classloto.Sheets("loto").Range("a1").Select
End Sub

Sub Macro1()
'
' Macro1 Macro
'

'
c = 1
b = 1
For i = 1 To 49
For j = i + 1 To 49

Cells(c, b).FormulaR1C1 = i
Cells(c, b + 1).FormulaR1C1 = j

c = c + 1
Next j
c = 1
b = b + 4
Next

End Sub

Sub rechcoupl2()

Dim coldroite, colgauche, i, d, compt, nbr, nbrcoup, deuzecol As Byte
colgauche = -3

Dim o, p As Byte
Dim der As Integer
nbrtirage
der = Selection.End(xlDown).Row
ReDim essaitab(1 To der, 1 To 6) As Byte
For o = 1 To der
For p = 1 To 6
essaitab(o, p) = Cells(o, p).Value
Next p
Next o
Debug.Print " mise en tableau terminée"

Do
coldroite = 0
colgauche = colgauche + 4
Do
compt = 0
test = False
w = 0
coldroite = coldroite + 1
Do
w = w + 1
For i = 1 To 6
nbr = essaitab(w, i)
nbrcoup = Workbooks("suite.xls").Sheets("couple").Cells(coldroite, colgauche).Value
If nbr = nbrcoup Then
test = True
Else: test = False

End If
If test = True Then
For d = 1 To 6
ktest = essaitab(w, d)
deuzecol = Workbooks("suite.xls").Sheets("couple").Cells(coldroite, colgauche + 1).Value
If ktest = deuzecol Then
compt = compt + 1
End If
Next d
GoTo décalage

End If
Next i

décalage:
Workbooks("suite.xls").Worksheets("couple").Cells(coldroite, colgauche + 2).Value = compt
Loop Until w = der
Debug.Print "avancement : " & Workbooks("suite.xls").Worksheets("couple").Cells(coldroite, colgauche + 1).Value
Loop Until Workbooks("suite.xls").Worksheets("couple").Cells(coldroite, colgauche + 1).Value = 49

Loop Until colgauche = 190
Windows("suite.XLS").Activate
End Sub

MACRO dans SUITE

macro dans ECART

Sub calcul()
'
' calcul Macro
'

'
Range("B1").Select
ActiveCell.FormulaR1C1 = "=COUNT(R[7]C:R[500]C)"
Range("B2").Select
ActiveCell.FormulaR1C1 = "=MAX(R[6]C:R[500]C)"
Range("B3").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(R[5]C:R[500]C)"
Range("B1:B3").Select
Selection.AutoFill Destination:=Range("B1:AX3"), Type:=xlFillDefault
Range("B1:AX3").Select
ActiveWindow.SmallScroll ToRight:=-14
Range("B5").Select
Calculate
Range("B8:AX500").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="0"
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 3
End With
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:="0", Formula2:="4"
Selection.FormatConditions(2).Interior.ColorIndex = 44
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
Formula1:="4"
Selection.FormatConditions(3).Interior.ColorIndex = 45
Range("B7").Select
Call actuel
End Sub

Sub ecart()

Workbooks("ecart.xls").Sheets(1).Range("b7:ax3000").Delete

For col = 2 To 51
compt = 0
Windows("LOTO.XLS").Activate
Workbooks("loto.xls").Sheets("loto").Range("a1").Select
Do
For i = 1 To 6
If Selection.Cells.Value = Workbooks("ecart.xls").Sheets(1).Cells(5, col).Value Then
With Workbooks("ecart.xls").Sheets(1).Cells(7, col)
.Insert (xlDown)
.Value = compt
End With

compt = 0
End If
Selection.Cells.Offset(0, 1).Activate
Next i
compt = compt + 1
Selection.Cells.Offset(1, -1).Activate
Selection.End(xlToLeft).Activate
Loop Until Selection.Value = 0

Next col
End Sub

Sub recent()
Dim tir As Integer

Workbooks("ecart.xls").Sheets(2).Range("b7:ax3000").Delete

tir = InputBox("Nombre tirages : ")

For col = 2 To 51
compt = 0
Windows("LOTO.XLS").Activate
Workbooks("loto.xls").Sheets("loto").Range("a1").Select
Selection.End(xlDown).Select
quest = 0

Do
quest = quest + 1
For i = 1 To 6
If Selection.Cells.Value = Workbooks("ecart.xls").Sheets(2).Cells(5, col).Value Then
With Workbooks("ecart.xls").Sheets(2).Cells(7, col)

.Value = compt
.Insert (xlDown)
End With

compt = 0
End If
Selection.Cells.Offset(0, 1).Activate
Next i
compt = compt + 1
Selection.Cells.Offset(-1, -1).Activate
Selection.End(xlToLeft).Activate
Loop Until quest = tir

Next col

Windows("ecart.xls").Activate
Workbooks("ecart.xls").Sheets(2).Cells(1, 1).Value = (" nbr sortie sur " & tir)
End Sub

MACRO dans ECART.

Sub actuel()
'
' Macro1 Macro
'

'
For f = 2 To 50
Cells(8, f).End(xlDown).Activate
Cells(4, f).Value = Selection.Value
Next f
Range("b4").Activate

End Sub