none
faire les permutation avec un element pris dans des tableaux en excel RRS feed

  • Question

  • Public Sub CreationChemin()
    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 = Range("A1:C10").Value
    sngChrono = Timer
    intI1 = 1
    Do Until Cells(1, intI1).Value = ""
    intI1 = intI1 + 1
    Loop
    Cells(1, intI1).Select
    intN = Len(strTab)
    ActiveCell.Value = strTab
    ActiveCell.Offset(1, 0).FormulaR1C1 = "=counta(R4C:R65536C)"
    ActiveCell.Offset(3, 0).Select
    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
    Cells(3, ActiveCell.Column).Value = (Timer - sngChrono)
    End Sub
    mardi 21 avril 2015 14:49

Toutes les réponses

  • Bonjour,

    Voici une procédure pour copier une zone d'un tableau vers une cellule Excel.
    Sélectionnez une zone sur une feuille, appuyez sur la touche Ctrl et Cliquez sur une cellule.

    on appel la procédure.

    Il reste à développer la procédure pour permuter les deux éléments de la feuille Excel.

    Public Sub Copier_Zone_Vers_Cellule()
    Dim Zone As String
    Dim Ligne As Long
    Dim Colonne As Integer
        
        ' Zone du tableau à copier
        Zone = Selection.Areas(1).Address
        
        ' Ligne et colonne de la cellule sélectionnée
        Ligne = Selection.Areas(2).Row
        Colonne = Selection.Areas(2).Column
            
        Range(Zone).Copy Cells(Ligne, Colonne)
    End Sub
    


    • Proposé comme réponse Denis 75 vendredi 26 août 2016 18:46
    jeudi 23 avril 2015 14:01