Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Concatenation Infinie ?

Créer une discussion
  • Initiateur de la discussion Initiateur de la discussion sandrabordeaux
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
S

sandrabordeaux

Guest
Bonjour à tous et bon week end pour les chanceux qui ne vont pas tarder à être en RTT.
Aujourd'hui je suis confrontée à un nouveau problème sur excel sur une concatenation "infinie".
je souhaite en effet associer l'intégralité de la première colonne avec l'ensemble des termes de la seconde colonne.
Je m'explique:
Col 1 BEAUREGARD
Col 2 Bar
Col 2 Mairie
Col 2 ...
Je souhaite en colonne 3
BEAUREGARD Bar
BEAUREGARD Mairie

Tout ceci de manière infinie pour avoir toutes les combinaisons possibles associant ces terrmes.
J'ai vu ça dans une formation mais je ne sais plus comment le retrouver, sachant que ma colonne 2 ne comporte pas beaucoup de termes mais que par la suite cela va s'agrandir.
Voici un fichier d'exemple pris avec des communes françaises.

Merci d'avance

Sandra
 

Pièces jointes

Dernière modification par un modérateur:
Trier par date Trier par votes
Re : Concatenation Infinie ?

Re

La macro adaptée pour Excel 97-2003
NB: tous les résultats sont affichés (5 colonnes)

Code: 
Sub concat()
debut = Timer
tablo1 = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
tablo2 = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
ReDim tabres(0)
For n = LBound(tablo1, 1) To UBound(tablo1, 1)
 For m = LBound(tablo2, 1) To UBound(tablo2, 1)
   tabres(UBound(tabres)) = tablo1(n, 1) & " " & tablo2(m, 1)
   ReDim Preserve tabres(UBound(tabres) + 1)
 Next
Next
Application.ScreenUpdating = False
colonne = 4
ligne = 2
For n = LBound(tabres) To UBound(tabres)
 Cells(ligne, colonne) = tabres(n)
 ligne = ligne + 1
  If ligne > 65536 Then
    ligne = 2
    colonne = colonne + 1
  End If
Next
Application.ScreenUpdating = True
MsgBox (Timer - debut)
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Concatenation Infinie ?

Bonjour à tous,
Il me semble que ma proposition est passée inaperçue 🙄 à moins que ce ne soit de l'ostracisme pur et simple...
Comment demander aux "questionneurs" d'être courtois quand les "habitués" ne le sont pas....
Bon courage à tous, et longue vie à XLD
Cordialement
 
Vote positif 0 Vote négatif
Re : Concatenation Infinie ?


Bonjour Efgé
Vous avez quand même 7 affichages ...

Plus sérieusement, le sujet est maintenant pour les plus tenaces car il y a longtemps que le demandeur ne s'y intéresse plus.
 
Vote positif 0 Vote négatif
Re : Concatenation Infinie ?

Bonjour à tous,

J'avais commencé puis arrêté. Je joins quand même. L'essai ressemble comme deux gouttes d'eau à celui de Efgé 🙂. Cet essai doit fonctionner aussi bien en excel 2003 (on répartit sur n colonnes) qu'en 2010. Sur ma bécane, le temps de traitement est d'env. 2.5s (version 2003) et à peu près le double si conversion en 2010.
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Concatenation Infinie ?

Bonjour à tous

@ Efgé

Me considérant comme habitué ,je me sens concerné par le # 18
Donc , non ton post n'est pas passé inaperçu mais comme il ne donnait pas toute la solution je me suis permis d'en proposer une autre
J'ai plus de scrupule vis à vis de Habitude dont j'avais ignoré les fichiers
Comme il le dit je fais parti des tenaces et surtout j'ai encore beaucoup à apprendre
C'est pourquoi je creuse cet exercice pour en savoir plus
j'ignorais par exemple ce que propose sapomme
xrg.Offset(, m).Resize(UBound(TabR, 1)) = TabR
qui parait écrire sur m colonnes un tableau a une seule dimension

@ sapomme
Ais-je bien compris ton xrg.Offset(, m).Resize(UBound(TabR, 1)) = TabR

@ tous

Peux-t-on m'expliquer pourquoi cette macro tourne mais ne donne aucun résultat (a tester sur excel 2007 ou 2010) ??

Code: 
Application.ScreenUpdating = False
debut = Timer
tablo1 = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
tablo2 = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
tot = UBound(tablo1, 1) * UBound(tablo2, 1)
ReDim tabres(tot, 1)
p = 0
For n = LBound(tablo1, 1) To UBound(tablo1, 1)
 For m = LBound(tablo2, 1) To UBound(tablo2, 1)
   tabres(p, 1) = tablo1(n, 1) & " " & tablo2(m, 1)
   p = p + 1
 Next
Next
ActiveSheet.Range("D2").Resize(UBound(tabres, 1), 1) = tabres
Application.ScreenUpdating = True
MsgBox (Timer - debut)
End Sub
 
Vote positif 0 Vote négatif
Re : Concatenation Infinie ?

Bonjour pierrejean, mapomme, le fil
Désolé pour hier soir, c'était un coup de gueule mal placé.
@ pierrejean
J'ai trouvé d'ou viens le défaut:
En déclarant
VB: 
ReDim tabres(tot, 1)
On déclare
VB: 
ReDim tabres(0 to tot,0 to 1)
Ensuite lorsque vous remplissez le tableau:
VB: 
tabres(p, 1) = tablo1(n, 1) & " " & tablo2(m, 1)
Vous remplissez la colonne 1. Donc la ligne :
VB: 
ActiveSheet.Range("D2").Resize(UBound(tabres, 1), 1) = tabres
colle la colonne 0 du tableau (donc la vide)
En utilisant
VB: 
tabres(p, 0) = tablo1(n, 1) & " " & tablo2(m, 1)
Tout reviens dans l'ordre
Cordialement

EDIT Ou se mettre en Option Base 1 🙂
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Concatenation Infinie ?

Bonjour pierrejean 🙂, Efgé 🙂 , à tous,

pierrejean à dit:
xrg.Offset(, m).Resize(UBound(TabR, 1)) = TabR
qui parait écrire sur m colonnes un tableau a une seule dimension

@ sapomme
Ais-je bien compris ton xrg.Offset(, m).Resize(UBound(TabR, 1)) = TabR
Cliquez pour agrandir...

L'instruction transfère le contenu de TabR sur la feuille dans une seule colonne et sur plusieurs lignes à partir de la cellule xrg.Offset(, m).

A chaque fois que le tableau TabR atteint ModMax lignes, il est déversé dans la feuille, à partir de la cellule xrg, cellule qu'on aura déplacée de m colonnes vers la droite.

Le tableau résultat se construit donc colonne par colonne. Pour le voir, on peut mettre un point d'arrêt sur la ligne de la 2ième instruction Redim... puis lancer la macro et regarder ce qui se passe sur la feuille résultat à chaque pause de la macro.

La déclaration de TabR par ReDim TabR(1 To ModMax, 1 To 1) en fait formellement (je crois) un tableau à deux dimensions (puisque déclaré comme tel) mais sans aucun degré de liberté pour la 2ième dimension puisque toujours égale à 1.

Si on déclarait TabR par ReDim TabR(1 To ModMax), je crois qu'on aurait un tableau à une seule dimension mais qui serait "rangé" comme un tableau en ligne. D'ailleurs si on le fait, ( en remplaçant les TabR(k, 1) par TabR(k) ), le transfert donnerait le même résultat pour toutes les cellules d'une même colonne, résultat qui serait le 1ier élément de tabR.

J'en profite. Un grand merci à Efgé pour ses explications. Finalement, en même temps que "Option Explicit" que j'utilise systématiquement, ça vaut peut-être aussi la peine de rajouter "Option Base" quoique souvent j'utilise dans mes codes le redimensionnement de tableau avec 1 to N qui permet de fixer les choses clairement.
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Concatenation Infinie ?

Re
En fait ,je me suis piégé moi même
Dans un 1er temps j'ai utilisé un tableau a une seule dimension Dim tbres(0)
Mais ce tableau semble être 'horizontal'
lorsque je veux le mettre dans une feuille il faut utiliser Transpose
Dans le cas présent le ubound trop important conduit à une erreur lors du Transpose
Je me suis dit qu'un 'faux tableau a 2 dimensions' tel que celui que l'on obtient avec Tablo=range("A2:A200") ne nécessiterait plus Transpose
Avec ce genre de tableau on trouve un contenu avec tablo(n,1) et j'ai donc reconduit cette formulation

Par ailleurs j'ai dit une bêtise a propos de xrg.Offset(, m).Resize(UBound(TabR, 1)) = TabR
TabR est bien la un tableau a 2 dimensions

J'ai donc fini par accoucher de ceci qui ,bien entendu, est une pale copie de vos œuvres

Code: 
Sub concat()
Application.ScreenUpdating = False
debut = Timer
tablo1 = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
tablo2 = Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
tot = UBound(tablo1, 1) * UBound(tablo2, 1)
ncol = Abs(tot / Rows.Count) + 1
ReDim tabres(Rows.Count - 2, 0)
p = 0
For n = LBound(tablo1, 1) To UBound(tablo1, 1)
 For m = LBound(tablo2, 1) To UBound(tablo2, 1)
   tabres(p, UBound(tabres, 2)) = tablo1(n, 1) & " " & tablo2(m, 1)
    p = p + 1
   If p > UBound(tabres, 1) Then
    ReDim Preserve tabres(UBound(tabres, 1), UBound(tabres, 2) + 1)
    p = 0
   End If
 Next
Next
ActiveSheet.Range("D2").Resize(UBound(tabres, 1), ncol) = tabres
Application.ScreenUpdating = True
MsgBox (Timer - debut)
End Sub
 
Vote positif 0 Vote négatif
Re : Concatenation Infinie ?

bonjour tous🙂🙂🙂🙂🙂🙂

apporte rien sur le sujet mais..... bravo a vous tous pour toutes les solutions que vous avez su deploier
assez impressionnant🙂🙂
bisous a vous tous leti
 
Vote positif 0 Vote négatif
Re : Concatenation Infinie ?

Re, Bonjoue Laeticia ,
J'en profite pour "re" mettre ce Ce lien n'existe plus qui explique avec schéma les tableaux de 1, 2 ou 3 dimentions.
Cela pourra être utile aux recherches futures 😀
Cordialement
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Concatenation Infinie ?

Re
En repartant de la très bonne idée de pierrejean, (remplir un tableau unique) je pensai accélérer les choses en évitant le Redim Preserve...
Ce n'est pas vraiment évident (nous gagnons des pouillèmes...), et ce même en option explicit.....
VB: 
Sub concat2()
'http://www.excel-downloads.com/forum/206244-concatenation-infinie.html#post1290012


Dim n&, m&, P&, L&, Tot&, NbCol&
Dim Tablo1 As Variant, Tablo2 As Variant
Dim Debut!


Debut = Timer
With Sheets("data")
    Tablo1 = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(3))
    Tablo2 = .Range(.Cells(2, 2), .Cells(.Rows.Count, 2).End(3))
End With


Tot = UBound(Tablo1, 1) * UBound(Tablo2, 1)
NbCol = Int(Tot / Rows.Count) + 1
ReDim tabres(1 To Rows.Count - 2, 1 To NbCol)
P = 1: L = 1


For n = LBound(Tablo1, 1) To UBound(Tablo1, 1)
    For m = LBound(Tablo2, 1) To UBound(Tablo2, 1)
        tabres(L, P) = Tablo1(n, 1) & " " & Tablo2(m, 1)
        L = L + 1
        If L > UBound(tabres, 1) Then
            P = P + 1
            L = 1
        End If
    Next m
Next n


Application.ScreenUpdating = False
With Sheets("Resultat")
     '.UsedRange.ClearContents 'en cas d'utilisation multiple
    .Range("A1").Resize(UBound(tabres, 1), UBound(tabres, 2)) = tabres
    '.Columns.AutoFit 'en cas d'utilisation multiple
End With
Application.ScreenUpdating = True


MsgBox (Timer - Debut)
End Sub

Si quelqu'un à une idée.... 😀

Cordialement
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…