Liste de chiffre Résolu/Fermé

Question

Bonjour a tous, 
 Voila j'ai un souci, j'ai une liste de nombre qui varie et j'aimerais avoirs toute les possibilité possible entre ses nombre sans qu'il se répète.
Et donc j'aimerais savoir si il existe une formule pour faire ceci car après plein de recherche je n'ai rien trouvé.

Petit exemple:
j'ai les chiffre suivant 1,2,3,4

j'aimerai avoir les possibilité suivante 
1234
1243
1324
1342
1432
1423
2134
2143
...

pijaku · Accepted Answer

Bonjour tout le monde,
Comment va Le Pivert?

Un autre exemple, récursif celui-ci :
Dim Tb(), IndTab As Long

Sub Combinaisons()
Dim strTab As String
'initialisation variables
Erase Tb
IndTab = 0
strTab = UCase(InputBox("Saisissez les éléments : ", "Saisie", "1234"))
'lancement procédure récursive
Combiner strTab, ""
'restitution des données
Range("A2").Resize(UBound(Tb) + 1) = Application.Transpose(Tb)
End Sub

Sub Combiner(strText As String, debut As String)
Dim i As Integer

If Len(strText) = 1 Then
    ReDim Preserve Tb(IndTab)
    Tb(IndTab) = debut & strText
    IndTab = IndTab + 1
Else
    For i = 1 To Len(strText)
        Combiner Mid(strText, 2, Len(strText) - 1), debut & Mid(strText, 1, 1)
        strText = Mid(strText, 2, Len(strText) - 1) & Mid(strText, 1, 1)
    Next
End If
End Sub

cs_Le Pivert · Answer

Bonjour,

En vba:

Public Sub combinaison()
    Dim intI1 As Integer, intI2 As Integer, intI3 As Integer
    Dim intI4 As Integer, intI5 As Integer, intI6 As Integer, intN As Integer
    Dim strTab As String
    Dim sngChrono As Single
    
    strTab = UCase(InputBox("Saisissez les éléments : ", "Saisie", "1234"))
    
    
    intI1 = 1
    Do Until Cells(1, intI1).Value = ""
        intI1 = intI1 + 1
    Loop
    Cells(1, intI1).Select
    
    intN = Len(strTab)
    ActiveCell.Value = strTab
    
    For intI1 = 1 To intN
        For intI2 = 1 To intN
            If intI2 <> intI1 Then
                For intI3 = 1 To intN
                    If intI3 <> intI1 And intI3 <> intI2 Then
                        If Len(strTab) = 3 Then
                            ActiveCell.Value = Mid(strTab, intI1, 1) & Mid(strTab, intI2, 1) & Mid(strTab, intI3, 1)
                            ActiveCell.Offset(1, 0).Select
                        Else
                            For intI4 = 1 To intN
                                If intI4 <> intI1 And intI4 <> intI2 And intI4 <> intI3 Then
                                    If Len(strTab) > 4 Then
                                        For intI5 = 1 To intN
                                            If intI5 <> intI1 And intI5 <> intI2 And intI5 <> intI3 And intI5 <> intI4 Then
                                                If Len(strTab) > 5 Then
                                                    For intI6 = 1 To intN
                                                        If intI6 <> intI1 And intI6 <> intI2 And intI6 <> intI3 And intI6 <> intI4 And intI6 <> intI5 Then
                                                            ActiveCell.Value = Mid(strTab, intI1, 1) & Mid(strTab, intI2, 1) & Mid(strTab, intI3, 1) _
                                                                            & Mid(strTab, intI4, 1) & Mid(strTab, intI5, 1) & Mid(strTab, intI6, 1)
                                                            ActiveCell.Offset(1, 0).Select
                                                        End If
                                                    Next
                                                Else
                                                    ActiveCell.Value = Mid(strTab, intI1, 1) & Mid(strTab, intI2, 1) & Mid(strTab, intI3, 1) _
                                                        & Mid(strTab, intI4, 1) & Mid(strTab, intI5, 1)
                                                    ActiveCell.Offset(1, 0).Select
                                                End If
                                            End If
                                        Next
                                    Else
                                        ActiveCell.Value = Mid(strTab, intI1, 1) & Mid(strTab, intI2, 1) & Mid(strTab, intI3, 1) & Mid(strTab, intI4, 1)
                                        ActiveCell.Offset(1, 0).Select
                                    End If
                                End If
                            Next
                        End If
                    End If
                Next
            End If
        Next
    Next
    
End Sub

Deudeu · Answer

Merci beaucoup cs_Le Pivert et pijaku c'est exactement ce qu'il me fallait, il faut juste que j'arrange le code de pijaku car tu affiche la ligne dans une cellule et mois je voudrais que chaque nombre soit dans une cellule et une fois qui'il a finit de faire la ligne il passe en dessous mais merci vous m'avez été d'une grande aide
Par contre j'ai un petit problème quand je rentre 12345678 cela fonctionne parfaitement mais quand je rentre 123456789 il me met qu'il y a une comparabilité de type savez vous d'ou cela peut provenir et quand je met des lettre il trouve rien .

pijaku · Answer

Pour ton second souci, nous étions parti sur une procédure permettant la permutation de 4-5 chiffres...
Le nombre de permutation, si tu mets 10 caractères devient beaucoup plus important. Ce qui bloque alors c'est la méthode Transpose. Celle-ci est bloquée à un peu plus de 65000 "lignes", nombre de lignes max pour Excel < 2007.
Pour plus de permutations, il convient alors de créer ta propre petite fonction de transposition de tableau.
ATTENTION, tu seras de toutes manières limité à un certain nombre de caractères...
Comme ceci (je te remet le tout comme ça tu n'as plus qu'un copié/collé à faire) :

Dim Tb(), IndTab As Long

Sub Combinaisons()
Dim strTab As String, Tab_Out(), Tb_Fin(), i As Long, j As Byte
'initialisation variables
Erase Tb
IndTab = 0
strTab = UCase(InputBox("Saisissez les éléments : ", "Saisie", "12345"))
'lancement procédure récursive
Combiner strTab, ""
'séparation des caractères
ReDim Preserve Tab_Out(1 To Len(strTab), 1 To IndTab)
For i = 0 To UBound(Tb)
    For j = 1 To Len(strTab)
        Tab_Out(j, i + 1) = Mid(Tb(i), j, 1)
    Next j
Next i
'restitution des données
ReDim Preserve Tb_Fin(UBound(Tb) + 1, Len(strTab))
Range("A2").Resize(UBound(Tb) + 1, Len(strTab) + 1) = Transposition(Tab_Out, Tb_Fin)
End Sub

Sub Combiner(strText As String, debut As String)
Dim i As Integer

If Len(strText) = 1 Then
    ReDim Preserve Tb(IndTab)
    Tb(IndTab) = debut & strText
    IndTab = IndTab + 1
Else
    For i = 1 To Len(strText)
        Combiner Mid(strText, 2, Len(strText) - 1), debut & Mid(strText, 1, 1)
        strText = Mid(strText, 2, Len(strText) - 1) & Mid(strText, 1, 1)
    Next
End If
End Sub

Function Transposition(Tb_Out, T_Fin) As Variant
Dim i As Long, j As Long

For j = LBound(Tb_Out, 1) To UBound(Tb_Out, 1)
        For i = LBound(Tb_Out, 2) To UBound(Tb_Out, 2)
            T_Fin(i, j) = Tb_Out(j, i)
        Next i
    Next j
    Transposition = T_Fin
End Function

 
&#127932; Cordialement,
Franck &#127926;

Deudeu · Answer

Merci beaucoup mais j'ai peut etre trouver une alternative genre j'en calcul 2000 que je met dans la feuille et vu que j'ai des calcul a effectuer j'effectue mes calcul j'efface tout dont je n'ai pas besoin et j'en recalcul 2000 et ainsi de suit juste attend de tout finir les possiilité

cordialement

Liste de chiffre

5 réponses

Discussions similaires