XL 2019 Générateur de mot automatiquement selon une liste définie

ColinWOOD · 30 Avril 2021

Salut !

J'ai grandement besoin d'aide...

En gros je voudrais générer de manière automatique toutes les possibilité de nom avec les deux mots. Mais je ne sais pas comment m'y pendre. J'ai trouvé une technique super longue... Et là ça va il n'y a que 8 mots mais moi j'en ai 400 !

Si vous avez une solution je suis preneur !!!!

Merci par avance

patricktoulon · 30 Avril 2021

re
c'est pourtant simple
dans le module thisworkbook tu met

VB:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect([A:B], Target) Is Nothing Then test
End Sub
Sub test()
    Dim tablo, tablo2, ligne&, col&
    tablo = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Resize(, 2).Value
    ReDim tablo2(1 To UBound(tablo), 1 To UBound(tablo) + 1)
    For ligne = 1 To UBound(tablo)
        For col = 1 To UBound(tablo)
            tablo2(ligne, col) = tablo(ligne, 1) & " " & tablo(col, 2)
        Next
    Next
[D1].Resize(UBound(tablo), UBound(tablo)) = tablo2
End Sub

comme ça des un changement ça te met le tableau a jour

c'est du travail mâché

ColinWOOD · 30 Avril 2021

Je vous embête encore mais je dois avoir loupé une étape parce que ça ne marche pas ...

Etoto · 30 Avril 2021

ColinWOOD à dit:
Je vous embête encore mais je dois avoir loupé une étape parce que ça ne marche pas ...
Regarde la pièce jointe 1104084

Heu oui moi aussi le code me renvoie une erreur

ColinWOOD · 30 Avril 2021

Etoto à dit:
Heu oui moi aussi le code me renvoie une erreur

Donc c'est pas de ma faute

Etoto · 30 Avril 2021

ColinWOOD à dit:
Donc c'est pas de ma faute

Et c'est exactement la même erreur que toi

Etoto · 30 Avril 2021

@ColinWOOD vu que tu peux éditer la conversation enlève l'indication qui dit que la conversation est résolue comme ça d'autres personne pourrons nous aider comme l'a fait @patricktoulon.

ColinWOOD · 30 Avril 2021

Etoto à dit:
@ColinWOOD vu que tu peux éditer la conversation enlève l'indication qui dit que la conversation est résolue comme ça d'autres personne pourrons nous aider comme l'a fait @patricktoulon.

C'est fait !

Usine à gaz · 30 Avril 2021

Bonjour Patrick, le Forum,
Le fichier ci-joint fonctionne,
lionel

Etoto · 30 Avril 2021

Usine à gaz à dit:
Bonjour Patrick, le Forum,
Le fichier ci-joint fonctionne,
lionel

Elle fonctionne super mais dés qu'on rajoute un élément à la colonne A et B, elle renvoie aussi une erreur, tu sais si tu arrives à changer cela ?

Usine à gaz · 30 Avril 2021

Mettez un fichier avec ce que vous voulez faire

mapomme · 30 Avril 2021

Bonjour à tous,

Avec une formule en E2 à copier suffisamment à droite puis suffisamment vers le bas jusqu'à obtenir des cellules vides.

patricktoulon · 30 Avril 2021

ma fois la solution est bonne
si ça ne fonctionne pas c'est que tu a fait quelque chose de travers
prend la peine de nous livrer ton fichier on verra

mapomme · 30 Avril 2021

Re,

Par VBA.
Code dans le module de la feuille "Feuil1":

VB:

Sub MarionsLes()
Dim t1, t2, i&, j&
   Range(Range("e2"), Range("e2").End(xlToRight).End(xlDown)).Clear
   t1 = Range("a1").Resize(Cells(Rows.Count, "a").End(xlUp).Row)
   t2 = Range("b1").Resize(Cells(Rows.Count, "b").End(xlUp).Row)
   If Not IsArray(t1) Or Not IsArray(t2) Then Exit Sub
   ReDim t(1 To UBound(t1) - 1, 1 To UBound(t2) - 1)
   For i = 2 To UBound(t1): For j = 2 To UBound(t2): t(i - 1, j - 1) = t1(i, 1) & " " & t2(j, 1): Next j, i
   Range("e2").Resize(UBound(t), UBound(t, 2)) = t
End Sub

edit : bonjour @Usine à gaz

patricktoulon · 30 Avril 2021

re
c'est pourtant simple
dans le module thisworkbook tu met

VB:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect([A:B], Target) Is Nothing Then test
End Sub
Sub test()
    Dim tablo, tablo2, ligne&, col&
    tablo = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Resize(, 2).Value
    ReDim tablo2(1 To UBound(tablo), 1 To UBound(tablo) + 1)
    For ligne = 1 To UBound(tablo)
        For col = 1 To UBound(tablo)
            tablo2(ligne, col) = tablo(ligne, 1) & " " & tablo(col, 2)
        Next
    Next
[D1].Resize(UBound(tablo), UBound(tablo)) = tablo2
End Sub

comme ça des un changement ça te met le tableau a jour

c'est du travail mâché

XL 2019 Générateur de mot automatiquement selon une liste définie

ColinWOOD

XLDnaute Nouveau

patricktoulon

ColinWOOD

XLDnaute Nouveau

Etoto

XLDnaute Barbatruc

ColinWOOD

XLDnaute Nouveau

Etoto

XLDnaute Barbatruc

Etoto

XLDnaute Barbatruc

ColinWOOD

XLDnaute Nouveau

Usine à gaz

XLDnaute Barbatruc

Pièces jointes

Etoto

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

Pièces jointes

patricktoulon

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

Pièces jointes

patricktoulon

XLDnaute Barbatruc

Discussions similaires