Re : Etude du loto (Celle de l'Euromillion?)
Bonjour le forum
Bonjour Soenda
On vient de m'envoyer la macro modifiée par tes soins.
Ils m'avaient dit qu'elle ne fonctionnait pas ce que j'ai dit sur le "fil" mais je n'ai rien vérifié. par contre j'ai vérifié la dernière les "Amis du 7"
elle ne fonctionne pas.
Sub AssociationdePas()
'
' AssociationdePas Macro
'
Application.Calculation = xlManual
'Recherche = Fétiche
'Tu peux remplacer la ligne suivante 'Fétiche = Array(7, 21, 23, 24, 44) par
Dim fin%, fetiche(5) As Integer
For fin = 1 To 5
If Not IsNumeric([D1].Offset(, fin).Value) Or [D1].Offset(, fin).Value < 1 Then Exit For
fetiche(fin) = [D1].Offset(, fin).Value
Next
'Recherche = Array(27, 24, 10, 5, 0) 'à changer
Range("E2:I400").Font.ColorIndex = xlAutomatic
For li = 2 To Cells(2 ^ 16, 1).End(xlUp).Row
For co = 5 To 9
For i = 0 To 4
If Recherche(i) = Cells(li, co) Then
Cells(li, co).Font.ColorIndex = 5
End If
Next i
Next co
For i = 5 To 9
If Cells(li, i).Font.ColorIndex = 5 Then bleu = bleu + 1
Next i
Cells(li, 13) = bleu: bleu = 0
Next li
Application.Calculation = xlAutomatic
End Sub
Les "amisdu 7"
Option Explicit
Public fin As Integer
Public t() As Integer
Public tb() As Byte
Sub Charge()
Dim L%, C As Integer
With Feuil1
fin = .[A1].End(xlDown).Row - 2
ReDim t(fin, 4)
ReDim tb(fin, 50)
For L = 2 To fin + 2
For C = 3 To 7
t(L - 2, C - 3) = .Cells(L, C)
tb(L - 2, .Cells(L, C)) = 1
Next C, L
End With
End Sub
Sub LesAmisDu7()
Dim x%, L%, C%, Res(1 To 50) As Integer
Feuil2.Select
If Not IsNumeric([B1]) Or [B1] < 1 Or [B1] > 50 Then Exit Sub
x = [B1]
Charge
For L = 0 To fin
If tb(L, x) = 1 Then
For C = 0 To 4
Res(t(L, C)) = Res(t(L, C)) + 1
Next
End If
Next
Application.ScreenUpdating = False
[B3:B52] = Application.Transpose(Res)
[A3] = 1
[A3].AutoFill [A3:A52], xlFillSeries
[A2:B2].Offset(x).Delete xlUp
End Sub
Pour les internautes anciens tu sembles bien "compliqué"
Ne pourrais-tu pas être plus pratique ? celà m'éviterai de recevoir un bon nombre de mail (MP) des "anciens".
Merci de me lire.
a+
Michel