Combinaison possible différents mots

Fermé
Ilyesta57 Messages postés 1 Date d'inscription lundi 2 mars 2020 Statut Membre Dernière intervention 2 mars 2020 - 2 mars 2020 à 15:24
 Ilyesta57 - 3 mars 2020 à 14:05
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"

3 réponses

ThauTheme Messages postés 1442 Date d'inscription mardi 21 octobre 2014 Statut Membre Dernière intervention 29 juillet 2022 160
3 mars 2020 à 09:47
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

1
Je te remercie,
Car je suis vraiment débutant dans le domaine de la programmation
Merci pour tes explications qui m’ont bien servi
0
ThauTheme Messages postés 1442 Date d'inscription mardi 21 octobre 2014 Statut Membre Dernière intervention 29 juillet 2022 160
3 mars 2020 à 14:02
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

1
ThauTheme Messages postés 1442 Date d'inscription mardi 21 octobre 2014 Statut Membre Dernière intervention 29 juillet 2022 160
Modifié le 2 mars 2020 à 15:46
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


0
Whismeril Messages postés 19029 Date d'inscription mardi 11 mars 2003 Statut Contributeur Dernière intervention 26 avril 2024 931
2 mars 2020 à 16:35
Bonjour ThauTheme,
ReDim Preserve est très gourmand en ressources (ram et temps processeur), en effet, il alloue la mémoire pour un nouveau tableau et copie les données de l'ancien tableau vers le nouveau et enfin route la variable vers l'emplacement mémoire du nouveau tableau.

Pour optimiser tu peux utiliser Collection, c'est une implémentation des listes chainées, c'est beaucoup plus efficace.
https://docs.microsoft.com/fr-fr/office/vba/language/reference/user-interface-help/collection-object

Bonne journée
0
ThauTheme Messages postés 1442 Date d'inscription mardi 21 octobre 2014 Statut Membre Dernière intervention 29 juillet 2022 160 > Whismeril Messages postés 19029 Date d'inscription mardi 11 mars 2003 Statut Contributeur Dernière intervention 26 avril 2024
2 mars 2020 à 17:25
Bonjour le fil, bonjour le forum,

Merci pour le lien !...
0
Salut à toi ThauTheme

Encore merci, cela fonctionne à ravir
J’aimerai juste une brief explication pour :
- CurrentRegion
- Ubound
- ReDim Preserve
- Application.Transpose
- les variables TV et TL corresponde à quoi

Encore merci à toi
0
Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 776 > Whismeril Messages postés 19029 Date d'inscription mardi 11 mars 2003 Statut Contributeur Dernière intervention 26 avril 2024
3 mars 2020 à 10:55
Bonjour Whismeril,

Merci de cette précision sur ReDim Preserve, je savais que c'est lourd mais pas pourquoi.
Finalement dans le cas où on ne peut pas utiliser une collection (doublons, multidimensionnel, ...), il est donc préférable d'ajouter une boucle préalable pour mesurer la dimension finale du tableau et ne faire qu'un seul ReDim.

Cordialement,

Patrice
0
Whismeril Messages postés 19029 Date d'inscription mardi 11 mars 2003 Statut Contributeur Dernière intervention 26 avril 2024 931 > Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023
3 mars 2020 à 11:03
Bonjour Patrice.

Le multidimensionnel peut se gérer avec une collection de tableaux (si le nombre de dimensions est fixe) ou une collections de collections, ou encore avec une collection d'un objet métier (même si je ne connais qu'un seul membre qui écrit des classes en VBA....)

Les doublons, ben comme un tableau, si t'en veux pas faut les gérer.

Je ne fais pas de VBA, mais en C# je ne connais qu'un seul cas pour lequel il faut passer par un tableau, c'est quand on travaille avec une dll en C ou C++ qui ne connait que les tableaux pour les paramètres.
Dans ce cas, je génère le tableau juste au moment où j'en ai besoin, directement à la bonne taille.
0