VBA ou formule--comptage base différente

J

JJ1

Guest
Bonjour à tous,

Mon fichier est terminé avec votre aide-merci à tous.

Cet après-midi, j'ai voulu faire un contrôle rapide de mes séries et c'est le fiasco.

Je ne sais plus compter !

Merci
 

Pièces jointes

  • Classeur1.xlsx
    8.7 KB · Affichages: 58
  • Classeur1.xlsx
    8.7 KB · Affichages: 63
  • Classeur1.xlsx
    8.7 KB · Affichages: 63

tbft

XLDnaute Accro
Re : VBA ou formule--comptage base différente

Bonjour

je venu, j'ai vu ,et j'ai rien compris???
Pourrais tu me fournir une petite explication, stp?
 

Pièces jointes

  • Classeur1.xlsx
    10.4 KB · Affichages: 38
  • Classeur1.xlsx
    10.4 KB · Affichages: 42
  • Classeur1.xlsx
    10.4 KB · Affichages: 42
Dernière édition:

KenDev

XLDnaute Impliqué
Re : VBA ou formule--comptage base différente

Bonjour à tous,

@JJ1, Au lieu de :
31
15445
0
1
87720
97099
1
1
j'obtiens :
31
15444
0
1
87719
97098
1
Soit la même chose pour les petits écarts et une différence d'1 pour les grands. Quelle formules utilises tu? Cordialement

KD

Edit @tbft : je suppose que le nombre obtenu est le nombre de combinaisons séparant deux combinaisons si la logique de classement commence avec la n°1 = 1,2,3,4,5 et la n°1906884=45,46,47,48,49
 
Dernière édition:

KenDev

XLDnaute Impliqué
Re : VBA ou formule--comptage base différente

Bonjour à tous,

@tbft : Un exemple sera peut-être plus parlant :

Au lieu de 5n° parmi 49, prenons 3 parmi 5, toutes les combinaisons sont, dans l'ordre :

Code:
1:1,2,3
2:1,2,4
3:1,2,5
4:1,3,4
5:1,3,5
6:1,4,5
7:2,3,4
8:2,3,5
9:2,4,5
10:3,4,5

Il me semble donc que JJ1 s'est intéressé aux calcul genre
Code:
rang(2,3,5) - rang(1,2,4) =  8 - 2 = 6
, puisqu'il se trouve que dans l'ordre des combinaisons (49;5) on a:

Code:
rang(1;2;3;4;7) = 3
rang(1;2;3;4;38) = 34
rang(1;2;32;38;47) = 15478
rang(1;2;32;38;47) = 15478
rang(1;2;32;38;48) = 15479
rang(1;10;11;12;20) = 103198
rang(2;3;10;23;49) = 200296
rang(2;3;10;24;25) = 200297

Cordialement.

KD
 

KenDev

XLDnaute Impliqué
Re : VBA ou formule--comptage base différente

Bonjour,

Pour reprendre l'exemple du classeur fourni, si les combinaisons sont en A1:E8, en F2 :
Code:
=CmbRnk(RangeToCh(A2:E2);49;5)-CmbRnk(RangeToCh(A1:E1);49;5)
et faire glisser.

Les fonctions utilisées :

VB:
'----------------------------------------------------------------------------------------------------------------
'Rang de la combinaison chaine dans l'ordre des combinaisons de b éléments pris parmis a éléments****************
'Input : chaine combinaison, a, b********************************************************************************
'Option séparateur de la chaîne si différent de ";"**************************************************************
'----------------------------------------------------------------------------------------------------------------
Function CmbRnk(Ch$, a&, b&, Optional Separateur) As Variant
    Dim i&, j&, Tb&(), s$(), Ub&, Sp$
    On Error GoTo ErrTrp
    If Not IsMissing(Separateur) And Len(CStr(Separateur)) > 0 Then Sp = Left(CStr(Separateur), 1) Else Sp = ";"
    s = Split(Ch, Sp): Ub = UBound(s) + 1 :
    If b > a Or a < 1 Or b < 1 Or Not Ub = b Then
        CmbRnk = CVErr(xlErrNA)
    Else
        ReDim Tb(Ub)
        For i = 1 To Ub
            Tb(i) = Trim(s(i - 1))
            If Tb(i) > a Or Not Tb(i) > Tb(i - 1) Then GoTo ErrTrp
        Next i
        CmbRnk = 1
        For j = 1 To Ub
            For i = Tb(j - 1) + 2 To Tb(j)
                CmbRnk = CmbRnk + CmbNb(a + 1 - i, b - j)
        Next i, j
    End If
    Exit Function
ErrTrp:
    On Error GoTo 0
    CmbRnk = CVErr(xlErrNum)
End Function
'----------------------------------------------------------------------------------------------------------------
'Nombre de combinaisons de b éléments pris parmis a éléments*****************************************************
'Input : a, b****************************************************************************************************
'----------------------------------------------------------------------------------------------------------------
Function CmbNb(ByVal a&, ByVal b&) As Variant
    Dim c&
    On Error GoTo ErrTrp
    If Not a < 0 And Not b < 0 And Not b > a Then
        c = a - b
        If c = 0 Then
            CmbNb = 1
        Else
            If b < c Then c = b
            CmbNb = FactLim(a, c) / FactLim(c)
        End If
    Else
        CmbNb = CVErr(xlErrNum)
    End If
    Exit Function
ErrTrp:
    On Error GoTo 0
    CmbNb = CVErr(xlErrNum)
End Function
'----------------------------------------------------------------------------------------------------------------
'Factorielle de Lg***********************************************************************************************
'Option : limiter le nombre d'itérations*************************************************************************
'----------------------------------------------------------------------------------------------------------------
Function FactLim(ByVal Lg&, Optional NbIter) As Variant
    Dim i&, n&
    On Error GoTo ErrTrp
    If Not Lg < 0 Then
        If Not IsMissing(NbIter) Then n = CLng(NbIter) Else n = Lg
        If n > Lg Or n < 0 Then
            GoTo ErrTrp
        Else
            FactLim = 1
            If Lg > 0 Then
                For i = 0 To n - 1: FactLim = FactLim * (Lg - i): Next i
            End If
        End If
    Else
        FactLim = CVErr(xlErrNA)
    End If
    Exit Function
ErrTrp:
    On Error GoTo 0
    FactLim = CVErr(xlErrNum)
End Function
'----------------------------------------------------------------------------------------------------------------
'Concaténer un range dans une chaîne*****************************************************************************
'Input : Range***************************************************************************************************
'Output : Chaîne*************************************************************************************************
'Option séparateur de la chaîne si différent de ";"**************************************************************
'----------------------------------------------------------------------------------------------------------------
Function RangeToCh(Rng As Range, Optional Separateur) As String
    Dim sp$, c As Range
    If Not IsMissing(Separateur) Then sp = Left(CStr(Separateur), 1) Else sp = ";"
    For Each c In Rng
        RangeToCh = RangeToCh & sp & c
    Next c
    RangeToCh = Right(RangeToCh, Len(RangeToCh) - 1)
End Function

Histoire d'avoir un ensemble cohérent je rajoute la fonction inverse, CmbNth, qui donne la n-ième combinaison et CmbRnd, combinaison aléatoire.

VB:
'----------------------------------------------------------------------------------------------------------------
'Nième combinaisons de b éléments pris parmis a éléments*********************************************************
'Input : a, b, n*************************************************************************************************
'Output : chaine combinaison*************************************************************************************
'Option séparateur de la chaîne si différent de ";"**************************************************************
'----------------------------------------------------------------------------------------------------------------
Function CmbNth(ByVal a&, ByVal b&, ByVal n#, Optional Separateur) As Variant
    Dim Tb&(), Sp$, Ub&, i&
    Tb = CmbNthTab(a, b, n)
    Ub = UBound(Tb)
    If Ub > 0 Then
        If Not IsMissing(Separateur) And Len(CStr(Separateur)) > 0 Then Sp = Left(CStr(Separateur), 1) Else Sp = ";"
        CmbNth = Tb(1)
        For i = 2 To Ub: CmbNth = CmbNth & Sp & Tb(i): Next i
    Else
        CmbNth = CVErr(xlErrNum)
    End If
End Function
'----------------------------------------------------------------------------------------------------------------
'Nième combinaisons de b éléments pris parmis a éléments*********************************************************
'Input : a, b, n*************************************************************************************************
'Output : tableau (0 to b) avec tb(0)=0**************************************************************************
'Rem : ubound(tb)=0 si erreur ***********************************************************************************
'----------------------------------------------------------------------------------------------------------------
Function CmbNthTab(ByVal a&, ByVal b&, ByVal n#) As Long()
    Dim Tb&(), i&, x#, d&
    On Error GoTo ErrTrp
    If n < 1 Or b < 1 Or a < 1 Or b > a Then
        ReDim Tb(0)
    ElseIf n > CmbNb(a, b) Then
        ReDim Tb(0)
    Else
        ReDim Tb(b)
        Do
            d = d + 1
            x = 0
            For i = a - 1 - Tb(d - 1) To b - d Step -1
                x = Round(x + CmbNb(i, b - d))
                If Not n > x Then Exit For
            Next i
            Tb(d) = a - i
            n = Round(n - (x - CmbNb(i, b - d)))
        Loop Until d = b
    End If
    CmbNthTab = Tb
    Exit Function
ErrTrp:
    On Error GoTo 0
    ReDim Tb(0)
    CmbNthTab = Tb
End Function
'----------------------------------------------------------------------------------------------------------------
'Combinaison aléatoire de b éléments pris parmis a éléments******************************************************
'Input : a, b****************************************************************************************************
'Output : chaine combinaison*************************************************************************************
'Option séparateur de la chaîne si différent de ";"**************************************************************
'----------------------------------------------------------------------------------------------------------------
Function CmbRnd(ByVal a&, ByVal b&, Optional Separateur) As String
    Dim Tb&(), d#, Sp$, i&
    Application.Volatile
    On Error GoTo ErrTrp
    d = CmbNb(a, b)
    Randomize
    Tb = CmbNthTab(a, b, Int(d * Rnd) + 1)
    If Not IsMissing(Separateur) And Len(CStr(Separateur)) > 0 Then Sp = Left(CStr(Separateur), 1) Else Sp = ";"
    CmbRnd = Tb(1)
    For i = 2 To UBound(Tb): CmbRnd = CmbRnd & Sp & Tb(i): Next i
    Exit Function
ErrTrp:
    On Error GoTo 0
    CmbRnd = CVErr(xlErrNum)
End Function

Cordialement

KD
 
J

JJ1

Guest
Re : VBA ou formule--comptage base différente

Bonjour KD,

J'ai mis en place ton code hier soir, bravo !
Efficace et très rapide, comme on aime à XLD ..

par contre je n'ai pas (su ?) utilisé ta 2ème fonction aléatoire? je n'ai pas compris ce qu'elle faisait et comment faire la formule pour ?

merci beaucoup et bon samedi.
 

KenDev

XLDnaute Impliqué
Re : VBA ou formule--comptage base différente

Bonjour à tous,

Merci pour le retour JJ1. La fonction aléatoire sert à générer une combinaison aléatoire...

Exemple : avec
Code:
=CmbRnd(49;6)
, quelques résultats de F9 successifs :
5;11;13;25;29;47
1;11;14;22;30;44
5;9;15;16;30;40
2;11;26;32;45;46
6;17;21;26;37;41

ou encore avec
Code:
=CombinRnd(50;5)&" / " &CombinRnd(11;2)
4;21;35;41;48 / 7;11
14;27;29;32;37 / 9;11
5;8;20;45;47 / 1;9
7;21;26;40;48 / 6;9
3;18;32;40;45 / 4;10

Si ces fonctions sont utilisées dans le cadre d'étude de loteries alors une utilisation de cette fonction pourrait être de tester (dans le cadre d'une macro) une combinaison ou un échantillon de combinaisons sur autant de tirages aléatoires que l'on veut pour des calculs d'espérances mathématiques observées à comparer avec des calculs d'E.M calculées.

Cordialement

KD
 
J

JJ1

Guest
Re : VBA ou formule--comptage base différente

Bonjour

Merci pour l'explication de CombinRnd.
Effectivement, c'est intéressant car dans ma liste des combinaisons sorties, j'ai repéré des séquences qui se suivent (même identiques grâce à ton code où j'ai trouvé un écart de combinaison à 0)

As-tu une idée de la mise en oeuvre de cette macro (ma plage de combinaisons sorties fait environ 16000 lignes de 5N°)

Bonne soirée
 

Discussions similaires