Fusion intelligentes de tableaux

Résolu/Fermé

Ilm17 Messages postés 29 Date d'inscription mercredi 28 mai 2014 Statut Membre Dernière intervention 11 juin 2014 - 5 juin 2014 à 12:03
Ilm17 Messages postés 29 Date d'inscription mercredi 28 mai 2014 Statut Membre Dernière intervention 11 juin 2014 - 10 juin 2014 à 12:27

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

A voir également:

Fusion intelligentes de tableaux
Fusionner deux tableaux excel - Guide
Tableaux croisés dynamiques - Guide
Fusion pdf - Guide
Display fusion - Télécharger - Divers Utilitaires
Kega fusion - Télécharger - Émulation

7 réponses

Réponse 1 / 7

Ilm17 Messages postés 29 Date d'inscription mercredi 28 mai 2014 Statut Membre Dernière intervention 11 juin 2014 1
6 juin 2014 à 11:00

Aussi michel merci beaucoup d'avoir consacré de votr temp

Réponse 2 / 7

Bruce Willix Messages postés 11968 Date d'inscription mardi 24 mai 2011 Statut Contributeur Dernière intervention 12 juin 2018 2 587
5 juin 2014 à 12:07

Bonjour,

Vous êtes obligé de faire ça avec Excel ? Paske c'est le genre de chose qu'Access fait en 2 clics...

Ilm17 Messages postés 29 Date d'inscription mercredi 28 mai 2014 Statut Membre Dernière intervention 11 juin 2014 1
5 juin 2014 à 13:10

Commen le faire sur access?

Bruce Willix Messages postés 11968 Date d'inscription mardi 24 mai 2011 Statut Contributeur Dernière intervention 12 juin 2018 2 587
5 juin 2014 à 18:06

Tu es un peu familier avec le concept de base de données ou pas ?

Ilm17 Messages postés 29 Date d'inscription mercredi 28 mai 2014 Statut Membre Dernière intervention 11 juin 2014 1
5 juin 2014 à 18:25

Oui j'y suis familier

Réponse 3 / 7

Ilm17 Messages postés 29 Date d'inscription mercredi 28 mai 2014 Statut Membre Dernière intervention 11 juin 2014 1
5 juin 2014 à 12:09

Comment le faire sur access?

Réponse 4 / 7

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
Modifié par michel_m le 5/06/2014 à 14:07

Bonjour,

annulation, excusez moi

Michel

Ilm17 Messages postés 29 Date d'inscription mercredi 28 mai 2014 Statut Membre Dernière intervention 11 juin 2014 1
5 juin 2014 à 14:20

J'ai pas compris votre message

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
Modifié par michel_m le 5/06/2014 à 17:37

J'avais écris une erreur !

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

Combien de lignes environ dans la feuille1 ?

Ilm17 Messages postés 29 Date d'inscription mercredi 28 mai 2014 Statut Membre Dernière intervention 11 juin 2014 1
5 juin 2014 à 17:42

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

Ilm17 Messages postés 29 Date d'inscription mercredi 28 mai 2014 Statut Membre Dernière intervention 11 juin 2014 1
5 juin 2014 à 17:51

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

Ilm17 Messages postés 29 Date d'inscription mercredi 28 mai 2014 Statut Membre Dernière intervention 11 juin 2014 1
5 juin 2014 à 17:51

voir excel

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 7

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
6 juin 2014 à 10:10

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

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
6 juin 2014 à 10:22

DOUBLON !!!! :-(((
avec
https://forums.commentcamarche.net/forum/affich-30319710-fusion-intelligentes-de-tableaux-vba#p30322880

Ilm17: inscrit sur ma blacklist

Bruce Willix Messages postés 11968 Date d'inscription mardi 24 mai 2011 Statut Contributeur Dernière intervention 12 juin 2018 2 587
6 juin 2014 à 11:04

Il a fait que deux posts et n'est pas encore au fait des us et coutumes du forum ^^

Réponse 6 / 7

Ilm17 Messages postés 29 Date d'inscription mercredi 28 mai 2014 Statut Membre Dernière intervention 11 juin 2014 1
6 juin 2014 à 10:55

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

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
6 juin 2014 à 11:41

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....

Ilm17 Messages postés 29 Date d'inscription mercredi 28 mai 2014 Statut Membre Dernière intervention 11 juin 2014 1
6 juin 2014 à 11:46

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! :))

Ilm17 Messages postés 29 Date d'inscription mercredi 28 mai 2014 Statut Membre Dernière intervention 11 juin 2014 1
6 juin 2014 à 11:59

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

Ilm17 Messages postés 29 Date d'inscription mercredi 28 mai 2014 Statut Membre Dernière intervention 11 juin 2014 1
6 juin 2014 à 12:23

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

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
Modifié par michel_m le 6/06/2014 à 13:21

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....

Réponse 7 / 7

Ilm17 Messages postés 29 Date d'inscription mercredi 28 mai 2014 Statut Membre Dernière intervention 11 juin 2014 1
10 juin 2014 à 12:27

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.

Discussions similaires

ou sont les bananes ?

Impossible d'afficher le rapport de tableau croisé dynamique sur un rapport

code ascii

Nom de champs du tableau croisé dynamique non valide

liste de noms par ordre alphabétique

Discussions similaires

Newsletters