Fusion intelligentes de tableaux [Résolu/Fermé]

Signaler
Messages postés
29
Date d'inscription
mercredi 28 mai 2014
Statut
Membre
Dernière intervention
11 juin 2014
-
Messages postés
29
Date d'inscription
mercredi 28 mai 2014
Statut
Membre
Dernière intervention
11 juin 2014
-
Bonjour,

J'ai un petit souci avec mon programme VBA ci-dessous. J'ai trois feuilles ; voir classeur Excel ci-joint. J'ai dans la feuille 1 en colonne 1 des éléments A par exemple, qui prennent des valeurs sur les colonnes suivantes et une feuille2 où j'ai en colonne 1 ces mêmes éléments A avec dans la colonne 2 un élément correspondant à chaque A.
L'objectif est dans une feuille3 de copier pour un élément A de la feuille 1 la ligne correspondante en lui ajoutant les éléments de la colonne 2 de la feuille 2 correspondant, cela autant de fois qu'il y'a d'élément pour A sur cette colonne (voir feuille Excel).
J'obtient avec le code ci-dessous une boucl infinie. Avant de le modifier j'obtenais que la première ligne. Je suis un peu perdu étant débutant VBA.

Le fichier excel avec les trois feuilles en exemple: https://www.cjoint.com/?DFfl5P37EXq



Code VBA:


Sub Macro1()
Set t1 = ActiveWorkbook.Worksheets("feuilleT1")
Set T2 = Worksheets("feuilleT2")
Set T3 = Worksheets("feuilleT3")
T3.Cells.Delete Shift:=xlUp
Dim tab100(1, 1 To 50)
Dim if1_l As Integer, if1_c As Integer
Dim if2_l As Integer, if2_c As Integer, if3_c As Integer, if3_l As Integer
Dim it1_l As Integer, it1_c As Integer, if1_c_buf As Integer
Dim t100(1 To 100, 1)
Dim rup_blc_tb



'Initialisation

if2_l = 1
if1_l = 1
it1_l = 1
rup_blc_t1 = 0
if3_l = 1
if1_c_buf = 1
nbcle2 = 0
nbcle1 = 0

'Stockage dans le tableau t100 des valeurs de la feuillle 2 à ajouter aux lignes des la feuille 1 dans la feuille 3

Do While t1.Cells(if1_l, if1_c_buf).Value <> ""

Do While T2.Cells(if2_l, 1).Value <> "" And rup_blc_t1 = 0
If t1.Cells(if1_l, 1).Value = T2.Cells(if2_l, 1).Value Then
t100(it1_l, 1) = T2.Cells(if2_l, 2).Value
it1_l = it1_l + 1
End If
if2_l = if2_l + 1
Loop
it1_l = 1

'Remplissage de la feuille 3

' Remplissage en ligne de la feuille 3 avec les éléments de la feuille 1
Do While t100(it1_l, 1) <> ""
Do While t1.Cells(if1_l, if1_c_buf) <> ""
T3.Cells(it1_l + nbcle2, if1_c_buf).Value = t1.Cells(if1_l, if1_c_buf).Value
if1_c_buf = if1_c_buf + 1
nbcle1 = if1_c_buf
nbcle2 = it1_l + nbcle2
Loop
it1_l = itl_1 + 1
Loop

it1_l = 1
if1_c_buf = 1

' Remplissage de la colonne à fusionné stockée dans le tableau t100
Do While t100(it1_l, 1) <> ""
T3.Cells(it1_l, nbcle1).Value = t100(it1_l, 1)
it1_l = it1_l + 1
Loop

rup_blc_t1 = 1

' Reset Tableau
it1_l = 1
Do While t100(it1_l, 1) <> ""
t100(it1_l, 1) = ""
itl_l = itl + 1
Loop
' Fin reset tableau
if1_l = if1_l + 1
Loop




End Sub

7 réponses

Messages postés
29
Date d'inscription
mercredi 28 mai 2014
Statut
Membre
Dernière intervention
11 juin 2014
1
Aussi michel merci beaucoup d'avoir consacré de votr temp
1
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 76687 internautes nous ont dit merci ce mois-ci

Messages postés
11910
Date d'inscription
mardi 24 mai 2011
Statut
Contributeur
Dernière intervention
12 juin 2018
2 352
Bonjour,

Vous êtes obligé de faire ça avec Excel ? Paske c'est le genre de chose qu'Access fait en 2 clics...
Messages postés
29
Date d'inscription
mercredi 28 mai 2014
Statut
Membre
Dernière intervention
11 juin 2014
1
Commen le faire sur access?
Messages postés
11910
Date d'inscription
mardi 24 mai 2011
Statut
Contributeur
Dernière intervention
12 juin 2018
2 352
Tu es un peu familier avec le concept de base de données ou pas ?
Messages postés
29
Date d'inscription
mercredi 28 mai 2014
Statut
Membre
Dernière intervention
11 juin 2014
1
Oui j'y suis familier
Messages postés
29
Date d'inscription
mercredi 28 mai 2014
Statut
Membre
Dernière intervention
11 juin 2014
1
Comment le faire sur access?
Messages postés
16316
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
1 décembre 2020
3 082
Bonjour,

annulation, excusez moi

Michel
Messages postés
16316
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
1 décembre 2020
3 082
J'avais écris une erreur !

Tu as toujours le m^me texte dans la colonne A ?

Combien de lignes environ dans la feuille1 ?
Messages postés
29
Date d'inscription
mercredi 28 mai 2014
Statut
Membre
Dernière intervention
11 juin 2014
1
j'ai toujours le même texte dans la colonne de la feuille 1, A c'est un élément de la feuille 1 en position (1,1) c'est une exemple, et ce A apartient à une lingne(ligne1).

Le but c'est de fusionner dans une feuille 3 les lignes d'une feuille 1 avec un id = A par exemple en position(1, 1), autant de fois que cet id = A prend de valeurs toto sur une feuille 2 à 2 colonnes id (col 1) et toto (col2).
sur la feuille un je peut avoir 10000 ligne
Messages postés
29
Date d'inscription
mercredi 28 mai 2014
Statut
Membre
Dernière intervention
11 juin 2014
1
Il faut que l'élément (ex: id =A) de la ligne 1 toujours sur la colonne 1 feuille 1, soit égale à un élément (id=A) toujours sur la colonne 1de la feuille 2. Dans ce cas on fusionne cette ligne(feuille1) avec l'élément Y correspondant à (id=A) toujours sur la colonne 1 de la feuille2
Messages postés
29
Date d'inscription
mercredi 28 mai 2014
Statut
Membre
Dernière intervention
11 juin 2014
1
voir excel
Messages postés
16316
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
1 décembre 2020
3 082
Bonjour,

J'essaierai de te proposer qq chose ce matin :o)
Messages postés
16316
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
1 décembre 2020
3 082
Chose promise, chose due disait ma Grand-Mère

Option Explicit
Option Base 1

Sub concatener()
Dim Derlig As Integer, T_sh1, T_sh2
Dim T_sh3, Cptr1 As Integer, Cptr2 As Byte, Cptr3 As Long

'-------initialisations et mémorisation des feuilles
Application.ScreenUpdating = False
With Sheets(1)
Derlig = .Columns("A").Find("*", , , , , xlPrevious).Row
T_sh1 = .Range("A1:B" & Derlig)
End With
With Sheets(2)
Derlig = .Columns("B").Find("*", , , , , xlPrevious).Row
T_sh2 = Application.Transpose(.Range("B1:B" & Derlig))
End With
'----- remplissage de la variable-tableau pour feuille3
ReDim T_sh3(UBound(T_sh1) * UBound(T_sh2), 3)
Cptr3 = 1
For Cptr1 = 1 To UBound(T_sh1)
For Cptr2 = 1 To UBound(T_sh2)
T_sh3(Cptr3, 1) = T_sh1(Cptr1, 1)
T_sh3(Cptr3, 2) = T_sh1(Cptr1, 2)
T_sh3(Cptr3, 3) = T_sh2(Cptr2)
Cptr3 = Cptr3 + 1
Next
Next

'------Restitution
With Sheets(3)
.Range("A1:C30000").Clear
With .Range("A1").Resize(UBound(T_sh3), 3)
.Value = T_sh3
.Borders.Weight = xlThin
End With
.Activate
End With

End Sub




Messages postés
16316
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
1 décembre 2020
3 082
Messages postés
11910
Date d'inscription
mardi 24 mai 2011
Statut
Contributeur
Dernière intervention
12 juin 2018
2 352
Il a fait que deux posts et n'est pas encore au fait des us et coutumes du forum ^^
Messages postés
29
Date d'inscription
mercredi 28 mai 2014
Statut
Membre
Dernière intervention
11 juin 2014
1
Bonjour Michel_m,
Je ne sais pas pourquoi tu le prend ainsi? Si j'ai fait cela c'est parce que je suis nouveau sur ce forum(mon profil) et sur le premier sujet il n'apparaissait pas VBA dans mon intitulé, et je n'arrivais pas à le modifier raison pour laquelle j'ai recréer un nouveau sujet. Je pensait qu'avec VBA dans l'intitulé du sujet j'aurais eu mieux de visibilité! Mais finalement j'ai eu des interventions sur les deux sujets malgré que l'un ne comportait pas le mot VBA. Donc j'ai continuer à communiquer sur les deux sujet!
Aussi franchement je vois pas l'intéret que j'aurais à créer deux sujets pour une quelconque raison perverse! Et je ne voit pas l'intéret que vous porter à faire ce que vous faites!
En tout cas cette démarche était tout à fait innocente, si vous le prennait mal je m'en excuse! Avec mes salutations les plus respectueuse
Messages postés
16316
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
1 décembre 2020
3 082
Sur le forum, il ne faut jamais faire de doublon, tu restes sur le même et tu écris un "up!", si tu envisages 2 solutions -VBA ou pas-, tu le signales mais quand une solution semble + adaptée sans VBA ou l'inverse, généralement on t'en fait part..

De m^me, si tu poses la m^question sur d'autres forums, tu avertis en citant les forums concernés....
Messages postés
29
Date d'inscription
mercredi 28 mai 2014
Statut
Membre
Dernière intervention
11 juin 2014
1
Je ne savais pas tout cela. Merci pour l'information, c'est gentil de votre part! Je tiendrais compte de tout ce la pour la suite! :))
Messages postés
29
Date d'inscription
mercredi 28 mai 2014
Statut
Membre
Dernière intervention
11 juin 2014
1
Quand j'execute le programme, j'ai une erreur 91 pour la ligne: "Derlig = .Columns("A").Find("*", , , , , xlPrevious).Row"! Il s'affiche: variable objet ou variable de bloc With non définie
Messages postés
29
Date d'inscription
mercredi 28 mai 2014
Statut
Membre
Dernière intervention
11 juin 2014
1
Aussi sur la feuille1 je ne suis pas forcement limité à deux colonne il peut y en avoir plusieurs, sur l'excel c'était juste à titre d'exemple. Sur la feuille 2 je suis limité à deux colonnes.
Autre chose pour concatener une ligne de la feuille 1 et un élément de la colonne 2 de la feuille 2 il faut que l'élément de la colonne 1 de celle ligne(feuille 1) soit égale à l'élément de la colonne 1 de feuille 2! La concatenation est donc soumise à une condition d'égalité entre éléments des colonnes 1 des feuilles 1 et 2
Messages postés
16316
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
1 décembre 2020
3 082
Je viens d'essayer sur le classeur que tu m'as livré et je n'ai pas eu de problème...
https://www.cjoint.com/?3FgnoMgCzPX

D'autre part, je ne peux pas savoir ce que tu ne dis pas et donc, il faut que je re-travaille bénévolement 1 heure ou 2 pour prendre en compte tes oublis
De m^me, lorsque tu pose une question, tu dois absolument ^tre précis et complet; ainsi dans tes dernières :
je ne suis pas forcement limité à deux colonne il peut y en avoir plusieurs, sur l'excel c'était juste à titre d'exemple
c'est l'exemple m^me de ce qu'il ne faut pas écrire et je ne peux pas agir !!!
mais à toi de jouer: les modifs sont relativement faciles à faire....
Messages postés
29
Date d'inscription
mercredi 28 mai 2014
Statut
Membre
Dernière intervention
11 juin 2014
1
Bonjour,

Finalement je l'ai fait à coup de boucle while:



Sub Concatener()

' Recopie des colonnes de T1, T2
Set T1 = ActiveWorkbook.Worksheets("feuilleT1")
Set T2 = Worksheets("feuilleT2")
Set T3 = Worksheets("feuilleT3")
T3.Cells.Delete Shift:=xlUp

Dim i As Integer, j As Integer
Dim if1_l As Integer, if1_c As Integer
Dim if2_l As Integer, if2_c As Integer, if3_c As Integer, if3_l As Integer
Dim it1_l As Integer, it1_c As Integer, if1_c_buf As Integer
Dim t100(1 To 100, 1)


i = 1
Do While T1.Cells(1, i).Value <> ""
T3.Cells(1, i).Value = T1.Cells(1, i).Value
i = i + 1
Max_i = i - 1
Loop

j = 1
Do While T2.Cells(1, j + 1) <> ""
T3.Cells(1, Max_i + j).Value = T2.Cells(1, j + 1).Value
j = j + 1
Loop



'Initialisation Tableau


if1_l = 2
if1_c_buf = 1
it1_l = 1
rup_blc_t1 = 0
if3_l = 2

Do While T1.Cells(if1_l, 1).Value <> ""

if2_l = 2

' Reset Tableau
it1_l = 1
Do While t100(it1_l, 1) <> ""
t100(it1_l, 1) = ""
it1_l = it1_l + 1
Loop
it1_l = 1
' Fin reset tableau

'Chargement du tableau
Do While T2.Cells(if2_l, 1).Value <> "fin_col"
If T1.Cells(if1_l, 1).Value = T2.Cells(if2_l, 1).Value Then
t100(it1_l, 1) = T2.Cells(if2_l, 2).Value
it1_l = it1_l + 1
End If
if2_l = if2_l + 1
Loop
t100(it1_l, 1) = "fin_col"
it1_l = 1


'Alimentation feuille 3 début


'initialisation de la première ligne de feuille 3 avec la premiere ligne de feuille 1
if1_c_buf = 1
Do While T1.Cells(if1_l, if1_c_buf) <> "fin_lign"
T3.Cells(if3_l, if1_c_buf).Value = T1.Cells(if1_l, if1_c_buf).Value
if1_c_buf = if1_c_buf + 1

Loop



If t100(it1_l, 1) <> "fin_col" Then
T3.Cells(if3_l, if1_c_buf).Value = t100(it1_l, 1)
End If

'Duplication de la ligne de feuille 1 dans la feuille 3

if1_c_buf = 1
if3_l = if3_l + 1
it1_l = it1_l + 1

Do While t100(it1_l, 1) <> "fin_col"
if1_c_buf = 1
Do While T1.Cells(if1_l, if1_c_buf) <> "fin_lign"
T3.Cells(if3_l, if1_c_buf).Value = T1.Cells(if1_l, if1_c_buf).Value
if1_c_buf = if1_c_buf + 1
Loop
T3.Cells(if3_l, if1_c_buf).Value = t100(it1_l, 1)

it1_l = it1_l + 1
if3_l = if3_l + 1
Loop

if1_l = if1_l + 1
Loop




End Sub



Merci à tous pour votre aide.