Combinaison possible différents mots Fermé

Question

Bonjour, 

J'ai essayer de commencer quelque chose en VBA pour mon projet,
Je dois faire des combinaisons de mots avec une liste 
Le soucis c'est que j'ai une méthode mais il faudrait que j'arrive a incrémenter mes cellules au lieu de les rentrer une par une. 
Et que je dois dynamiser ma colonne A, car elle risque de changer. 
Merci d'avance pour votre aide 

Ci joint mon bout de code et mon tableau excelle : 
https://mon-partage.fr/f/itcn0E1H/

"Sub Combinaisons()
 
Dim iP1 As Long
Dim iDest As Long 
iDest = 1
 
For iP1 = 2 To Range("A:A").End(xlDown).Row

        Range("E1").Value = Range("A1").Value & "  " & Range("A2").Value
        Range("E2").Value = Range("A1").Value & "  " & Range("A3").Value
        Range("E3").Value = Range("A1").Value & "  " & Range("A4").Value
        Range("E4").Value = Range("A1").Value & "  " & Range("A5").Value
        Range("E5").Value = Range("A1").Value & "  " & Range("A6").Value
        Range("E6").Value = Range("A1").Value & "  " & Range("A7").Value
        Range("E7").Value = Range("A1").Value & "  " & Range("A8").Value
        Range("E8").Value = Range("A2").Value & "  " & Range("A3").Value
        Range("E9").Value = Range("A2").Value & "  " & Range("A4").Value
        Range("E10").Value = Range("A2").Value & "  " & Range("A5").Value
        Range("E11").Value = Range("A2").Value & "  " & Range("A6").Value
        Range("E12").Value = Range("A2").Value & "  " & Range("A7").Value
        Range("E13").Value = Range("A2").Value & "  " & Range("A8").Value
        
Next iP1
End Sub"

ThauTheme · Answer

Bonjour Ilyesta, bonjour le forum,

Essaie comme ça :
Sub Macro1()
Dim TV As Variant
Dim I As Integer
Dim J As Integer
Dim K As Integer
Dim TC() As Variant
TV = Range("A1").CurrentRegion
Dim TL() As Variant

K = 1
For I = 1 To UBound(TV, 1)
    For J = 1 To UBound(TV, 1)
        If TV(I, 1) <> TV(J, 1) Then
            ReDim Preserve TL(1 To K)
            TL(K) = TV(I, 1) & " " & TV(J, 1)
            K = K + 1
        End If
    Next J
Next I
Range("E1").Resize(K - 1, 1).Value = Application.Transpose(TL)
End Sub

ThauTheme · Answer

Re,

Plutôt que de travailler directement sur les cellules on utilise une variable tableau (de type Variant) car cela va dix fois plus vide. Ici je l'ai appelé TV (Tableau des Valeurs). Pour l'obtenir, je me place dans une des cellules du tableau (ici A1) et j'utilise CurrentRegion. Le tableau se dimensionne en fonction du nombre de lignes et du nombre de colonnes. L'accès aux données ne se fait plus via l'adresse dans la tableau Range("A1") ou Cell(1, 1) mais via sa position (ligne, Colonne) à l'intérieur du tableau TV(1, 1).
Quand le tableau commence en A1 comme toi ça simplifie beaucoup car Cells(1, 1) = TV(1, 1).
CurrentRegion va sélectionner toutes les cellules adjacentes d'un tableau. Comme quand on sélectionne une cellule et que l'on combine les touches [Ctrl]+[*]. Ça évite d'avoir à rechercher la dernière ligne éditée et la dernière colonne éditée du tableau. Mais ça implique que le tableau ne contienne aucune ligne ou colonne vide au milieu de celui-ci.

le tableau est donc à deux entrées les lignes (1) et le colonnes (2). La première valeur d'un tableau est récupérée par LBound(TV, 1) et la dernière par UBound(TV, 1) Pour les lignes
LBound(TV, 2) et UBound(TV, 2) pour les colonnes.

Les combinaison sont stockées dans un autre tableau TL (tableau des Lignes)
(1 lignes, K colonnes) redimensionné et alimenté chaque fois que la condition est vérifiée. À la fin, on renvoie le tableau TL dans la cellule E1 redimensionné (autant de lignes que TL et une seule colonne (K-1, 1) et comme on veut que les valeur s'affichent en ligne le tableau est transposé.

Le code  full comment :
Sub Macro1()
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

TV = Range("A1").CurrentRegion 'définit le tableau des Valeurs
K = 1 'initialise la variable K
For I = 1 To UBound(TV, 1) 'boucle 1 : sur toutes les lignes I du tableau des valeurs TV
    For J = 1 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes J du tableau des valeurs TV
        If TV(I, 1) <> TV(J, 1) Then 'condition si la valeur de la boucle 1 est différente de la valeur de la boucle 2
            ReDim Preserve TL(1 To K) 'redimensionne le tableau des lignes TL (K lignes)
            TL(K) = TV(I, 1) & " " & TV(J, 1) 'récupère la combinaison des deux valeurs dans la ligne TL(K)
            K = K + 1 'incrémente K
        End If 'fin de la condition
    Next J 'prochaine  ligne de la boucle 2
Next I 'prochaine  ligne de la boucle 1
Range("E1").Resize(K - 1, 1).Value = Application.Transpose(TL) 'renvoie dans E1 redimensionnée le tableau TL transposé
End Sub

ThauTheme · Answer

Re,

Pour faire plaisir à nos experts :
Sub Macro1()
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

TV = Range("A1").CurrentRegion 'définit le tableau des Valeurs
ReDim TL(1 To UBound(TV, 1) * (UBound(TV, 1) - 1)) 'redimensionne le tableau des lignes TL
K = 1 'initialise la variable K
For I = 1 To UBound(TV, 1) 'boucle 1 : sur toutes les lignes I du tableau des valeurs TV
    For J = 1 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes J du tableau des valeurs TV
        If TV(I, 1) <> TV(J, 1) Then 'condition si la valeur de la boucle 1 est différente de la valeur de la boucle 2
            TL(K) = TV(I, 1) & " " & TV(J, 1) 'récupère la combinaison des deux valeurs dans la ligne TL(K)
            K = K + 1 'incrémente K
        End If 'fin de la condition
    Next J 'prochaine  ligne de la boucle 2
Next I 'prochaine  ligne de la boucle 1
Range("E1").Resize(K - 1, 1).Value = Application.Transpose(TL) 'renvoie dans E1 redimensionnée le tableau TL transposé
End Sub

Combinaison possible différents mots

3 réponses

Discussions similaires