Concatenation Infinie ?

sandrabordeaux · 24 Mai 2013

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

pierrejean · 24 Mai 2013

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

Habitude · 24 Mai 2013

Re : Concatenation Infinie ?

Bonjour à tous

J'étais à moins de 1 sec mais je trichais un peu.
J'ai mis un nouvelle version avec concaténation en #13

Efgé · 24 Mai 2013

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

Habitude · 24 Mai 2013

Re : Concatenation Infinie ?

Efgé à dit:
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

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.

mapomme · 25 Mai 2013

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.

pierrejean · 25 Mai 2013

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

Efgé · 25 Mai 2013

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

pierrejean · 25 Mai 2013

Re : Concatenation Infinie ?

Re

Un gros MERCI Efgé
C'est bien cela !!!

mapomme · 25 Mai 2013

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

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.

pierrejean · 25 Mai 2013

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

laetitia90 · 25 Mai 2013

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

Efgé · 25 Mai 2013

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

Efgé · 25 Mai 2013

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

Effectuez une recherche sur Excel Downloads...

Concatenation Infinie ?

sandrabordeaux

XLDnaute Nouveau

Pièces jointes

pierrejean

XLDnaute Barbatruc

Habitude

XLDnaute Accro

Efgé

XLDnaute Barbatruc

Habitude

XLDnaute Accro

mapomme

XLDnaute Barbatruc

Pièces jointes

pierrejean

XLDnaute Barbatruc

Efgé

XLDnaute Barbatruc

pierrejean

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

pierrejean

XLDnaute Barbatruc

laetitia90

XLDnaute Barbatruc

Efgé

XLDnaute Barbatruc

Efgé

XLDnaute Barbatruc

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums