Fusion intelligentes de tableaux
Résolu
Ilm17
Messages postés
29
Date d'inscription
Statut
Membre
Dernière intervention
-
Ilm17 Messages postés 29 Date d'inscription Statut Membre Dernière intervention -
Ilm17 Messages postés 29 Date d'inscription Statut Membre Dernière intervention -
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
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
A voir également:
- Fusion intelligentes de tableaux
- Fusionner deux tableaux excel - Guide
- Display fusion - Télécharger - Divers Utilitaires
- Tableaux croisés dynamiques - Guide
- Les tableaux word - Guide
- Citez un des logiciels lui permettant de faire des calculs sur des tableaux de nombres (tableur). ✓ - Forum Logiciels
7 réponses
Bonjour,
Vous êtes obligé de faire ça avec Excel ? Paske c'est le genre de chose qu'Access fait en 2 clics...
Vous êtes obligé de faire ça avec Excel ? Paske c'est le genre de chose qu'Access fait en 2 clics...
Bonjour,
annulation, excusez moi
Michel
annulation, excusez moi
Michel
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
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
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
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
DOUBLON !!!! :-(((
avec
https://forums.commentcamarche.net/forum/affich-30319710-fusion-intelligentes-de-tableaux-vba#p30322880
Ilm17: inscrit sur ma blacklist
avec
https://forums.commentcamarche.net/forum/affich-30319710-fusion-intelligentes-de-tableaux-vba#p30322880
Ilm17: inscrit sur ma blacklist
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
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
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....
De m^me, si tu poses la m^question sur d'autres forums, tu avertis en citant les forums concernés....
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
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
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....
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....
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.
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.
