Besoin d'un technicien VBA pour tester méthodes casino

Option Explicit

Private Type Fourchette
    mini As Long
    Maxi As Long
End Type

'------ CONSTANTES A ADAPTER
Private Const MINIMUM As Long = 0           'premier nombre
Private Const MAXIMUM As Long = 36          'dernier nombre
Private Const NB_1 As Long = 13             'premier "écart" = intervalle ou trouver les doublons
Private Const NB_2 As Long = 71             'second "écart" = intervalle complément de NB_1 pour trouver triplon
Private Const COMPTEUR_1 As Long = 2        'premier compteur si doublon 2, si triplon 3 etc
Private Const COMPTEUR_2 As Long = 4        'second compteur si triplon 3, quadri 4 etc
Private Const NB_TIRAGES As Long = 10000    'Nombre de tirages aléatoires
Private Const FLAG As Boolean = True        'Limite les "fourchettes" ==> pour toutes mettre false
Private Const RANGE_RESTIT As String = "A1" 'l'adresse de la première cellule pour la restitution
'------------------------

Public Sub Liste_Aleas()
Dim i As Long, TbNbAleas() As Long, Resultats() As Variant
Dim T As Single

    T = Timer
    ReDim TbNbAleas(1 To NB_TIRAGES, 1 To 1)
    For i = 1 To NB_TIRAGES
        TbNbAleas(i, 1) = NbAlea(MINIMUM, MAXIMUM)
    Next
    Resultats = Recherche_Triplons_Particuliers(TbNbAleas)
    'restitution
    Range(RANGE_RESTIT) = "Numéro"
    Range(RANGE_RESTIT).Offset(0, 1) = "Fourchettes"
    Range(RANGE_RESTIT).Offset(0, 2) = "Triplons"
    Range(RANGE_RESTIT).Offset(1, 0).Resize(UBound(Resultats, 1), UBound(Resultats, 2)) = Resultats
    MsgBox "Fin en : " & Timer - T & " Secondes"
End Sub

Private Function NbAlea(min As Long, Max As Long) As Long
    Randomize Timer
    NbAlea = Int((Max - min + 1) * Rnd + min)
End Function

Private Function Recherche_Triplons_Particuliers(TbNbAlea() As Long) As Variant()
Dim TbFourchette() As Fourchette, NumeroAchercher As Long, temp() As Variant
Dim i As Long

    ReDim temp(1 To 37, 1 To 3)
    For NumeroAchercher = MINIMUM To MAXIMUM
        temp(NumeroAchercher + 1, 1) = NumeroAchercher
        TbFourchette = Est_Sorti_Deux_Fois(TbNbAlea, NumeroAchercher, NB_1, FLAG)
        On Error Resume Next
        temp(NumeroAchercher + 1, 2) = UBound(TbFourchette)
        If Err <> 0 Then
            temp(NumeroAchercher + 1, 2) = 0
            temp(NumeroAchercher + 1, 3) = 0
        Else
            temp(NumeroAchercher + 1, 3) = Nb_Triplons(TbNbAlea, NumeroAchercher, TbFourchette, NB_2)
        End If
        On Error GoTo -1
    Next
    Recherche_Triplons_Particuliers = temp
End Function

Private Function Est_Sorti_Deux_Fois(Tb() As Long, Nb As Long, Ecart As Long, Unique As Boolean) As Fourchette()
Dim i As Long, j As Long, cptDouble As Long, CptFourch As Long, F() As Fourchette, Stp As Long
    
    Stp = IIf(Unique, Ecart, 1)
    For i = LBound(Tb, 1) To UBound(Tb, 1) Step Stp
        For j = i To i + Ecart - 1
            If j > UBound(Tb, 1) Then Exit For
            If Tb(j, 1) = Nb Then cptDouble = cptDouble + 1
            If cptDouble = COMPTEUR_1 Then
                ReDim Preserve F(CptFourch)
                F(CptFourch).mini = i
                F(CptFourch).Maxi = i + Ecart - 1
                CptFourch = CptFourch + 1
                Exit For
            End If
        Next j
        cptDouble = 0
    Next i
    Est_Sorti_Deux_Fois = F
End Function

Private Function Nb_Triplons(Tb() As Long, Nb As Long, TbFourc() As Fourchette, Ecart As Long) As Long
Dim i As Long, j As Long, cpt_Triple As Long, res As Long

    cpt_Triple = 0
    For i = LBound(TbFourc) To UBound(TbFourc)
        For j = TbFourc(i).Maxi To TbFourc(i).Maxi + Ecart - 1
            If j > UBound(Tb, 1) Then Exit For
            If Tb(j, 1) = Nb Then cpt_Triple = cpt_Triple + 1
            If cpt_Triple = COMPTEUR_2 - COMPTEUR_1 Then res = res + 1: Exit For
        Next j
    Next i
    Nb_Triplons = res
End Function

• Tirage_Et_Resultats
• Verifions

Après ce que je voulais, c'est si on peut rajouter des constantes. Pour modifier les intervalles de références (la fourchette de base) et l'intervalle qui suit

ex: on avait fourchette 13 pour doublon et ensuite écart de 71 pour triplon
l'idée était de modifier cette fourchette de 13 et l'intervalle qui suit la sortie du numéro pour la deuxième fois de 71. Par ex on met 10 et 20 etc

Option Explicit

Private V As Boolean

Private Type Fourchette
    mini As Long
    Maxi As Long
End Type

'------ CONSTANTES A ADAPTER
Private Const MINIMUM As Long = 0           'premier nombre
Private Const MAXIMUM As Long = 36          'dernier nombre
Private Const NB_1 As Long = 13             'premier "écart" = intervalle ou trouver les doublons
Private Const NB_2 As Long = 71             'second "écart" = intervalle complément de NB_1 pour trouver triplon
Private Const COMPTEUR_1 As Long = 2        'premier compteur si doublon 2, si triplon 3 etc
Private Const COMPTEUR_2 As Long = 3        'second compteur si triplon 3, quadri 4 etc
Private Const NB_TIRAGES As Long = 100000   'Nombre de tirages aléatoires
Private Const FLAG As Boolean = True        'Limite les "fourchettes" ==> pour toutes mettre false
Private Const RANGE_RESTIT As String = "A1" 'l'adresse de la première cellule pour la restitution
'------------------------

Public Sub Tirage_Et_Resultats()
Dim TbNbAleas() As Long, Resultats() As Long
Dim T As Single

    T = Timer
    TbNbAleas = Liste_Aleas
    Resultats = Recherche_Triplons_Particuliers(TbNbAleas)
    'restitution
    Range(RANGE_RESTIT) = "Numéro"
    Range(RANGE_RESTIT).Offset(0, 1) = "Fourchettes"
    Range(RANGE_RESTIT).Offset(0, 2) = "Triplons"
    Range(RANGE_RESTIT).Offset(1, 0).Resize(UBound(Resultats, 1), UBound(Resultats, 2)) = Resultats
    MsgBox "Fin en : " & Timer - T & " Secondes"
End Sub

Public Sub Verifions()
Dim i As Long, TbNbAleas() As Long, F() As Fourchette, Nb As Long, cpt As Long

    ReDim TbNbAleas(1 To NB_TIRAGES, 1 To 1)
    cpt = 2: V = True
    Nb = MyInputBox
    For i = 1 To NB_TIRAGES
        TbNbAleas(i, 1) = NbAlea(MINIMUM, MAXIMUM)
        Cells(i + 1, 1) = TbNbAleas(i, 1)
        If Cells(i + 1, 1) = Nb Then Cells(cpt, 2) = i: cpt = cpt + 1
    Next
    F = Est_Sorti_Deux_Fois(TbNbAleas, Nb, NB_1, True)
    For i = LBound(F) To UBound(F)
        Cells(i + 2, 3) = F(i).mini & " <=> " & F(i).Maxi
    Next
    Cells(2, 5) = Nb_Triplons(TbNbAleas, Nb, F, NB_2)
    Range("A1") = "Liste"
    Range("B1") = "Positions du " & Nb
    Range("C1") = "Adresses fourchettes"
    Range("D1") = "Positions triplons"
    Range("E1") = "Nb Triplons"
    V = False
End Sub

Private Function Liste_Aleas() As Long()
Dim temp() As Long, i As Long

    ReDim temp(1 To NB_TIRAGES, 1 To 1)
    For i = 1 To NB_TIRAGES
        temp(i, 1) = NbAlea(MINIMUM, MAXIMUM)
    Next
    Liste_Aleas = temp
End Function

Private Function NbAlea(min As Long, Max As Long) As Long
    Randomize Timer
    NbAlea = Int((Max - min + 1) * Rnd + min)
End Function

Private Function Recherche_Triplons_Particuliers(TbNbAlea() As Long) As Long()
Dim TbFourchette() As Fourchette, NumeroAchercher As Long, temp() As Long
Dim i As Long

    ReDim temp(1 To 37, 1 To 3)
    For NumeroAchercher = MINIMUM To MAXIMUM
        temp(NumeroAchercher + 1, 1) = NumeroAchercher
        TbFourchette = Est_Sorti_Deux_Fois(TbNbAlea, NumeroAchercher, NB_1, FLAG)
        On Error Resume Next
        temp(NumeroAchercher + 1, 2) = UBound(TbFourchette) + 1
        If Err <> 0 Then
            temp(NumeroAchercher + 1, 2) = 0
            temp(NumeroAchercher + 1, 3) = 0
        Else
            temp(NumeroAchercher + 1, 3) = Nb_Triplons(TbNbAlea, NumeroAchercher, TbFourchette, NB_2)
        End If
        Erase TbFourchette
        On Error GoTo -1
    Next
    Recherche_Triplons_Particuliers = temp
End Function

Private Function Est_Sorti_Deux_Fois(Tb() As Long, Nb As Long, Ecart As Long, Unique As Boolean) As Fourchette()
Dim i As Long, j As Long, cptDouble As Long, CptFourch As Long, F() As Fourchette, Stp As Long
    
    Stp = IIf(Unique, Ecart, 1)
    For i = LBound(Tb, 1) To UBound(Tb, 1) Step Stp
        For j = i To i + Ecart - 1
            If j > UBound(Tb, 1) Then Exit For
            If Tb(j, 1) = Nb Then cptDouble = cptDouble + 1
            If cptDouble = COMPTEUR_1 Then
                ReDim Preserve F(CptFourch)
                F(CptFourch).mini = i
                F(CptFourch).Maxi = i + Ecart - 1
                CptFourch = CptFourch + 1
                Exit For
            End If
        Next j
        cptDouble = 0
    Next i
    Est_Sorti_Deux_Fois = F
End Function

Private Function Nb_Triplons(Tb() As Long, Nb As Long, TbFourc() As Fourchette, Ecart As Long) As Long
Dim i As Long, j As Long, cpt_Triple As Long, res As Long, cpt As Long

    cpt = 2
    For i = LBound(TbFourc) To UBound(TbFourc)
        cpt_Triple = 0
        For j = TbFourc(i).Maxi + 1 To TbFourc(i).Maxi + Ecart - 1
            If j > UBound(Tb, 1) Then Exit For
            If Tb(j, 1) = Nb Then cpt_Triple = cpt_Triple + 1
            If cpt_Triple = COMPTEUR_2 - COMPTEUR_1 Then
                If V Then
                    Cells(cpt, 4) = j: cpt = cpt + 1: res = res + 1: Exit For
                Else
                    res = res + 1: Exit For
                End If
            End If
        Next j
    Next i
    Nb_Triplons = res
End Function

Private Function MyInputBox() As Long
Dim bon As Boolean, entree As String, MyArray As Variant, i As Long, Dimens As Byte, Valeur As String

   Do While Not bon
        entree = InputBox("Entrer un nombre entre 0 et 36", "Saisie")
        If StrPtr(entree) <> 0 Then
            If IsNumeric(entree) Then
                If entree >= 0 And entree <= 36 Then bon = True
            End If
        End If
    Loop
    MyInputBox = CLng(entree)
End Function