XL 2021 vba fusion lignes et colonnes pour cellules identiques

[cbar]

Bonjour à tous,
Pas calé en vba, des jours que je cherche sur le net la solution à mon problème, mais rien !
Voilà mon problème : j'ai un tableau avec des cellules en g,h,i,j 7 à 18
Il se trouve que pour les lignes suivantes il y ai le même résultat (formule). Je voudrais fusionner les lignes identiques centrées en horizontal et verticale.
Même opération pour les colonnes k,l,m et n,o,p
ce que j'ai avant ce que je voudrais après

et le top masquer les lignes vides qui contiennent des formules
Je dois faire cette manipulation manuellement une dizaine de fois par jour !
NB: les revetements changent à chaque dossier
Je vous joind l'extrait de mon fichier
Un grand merci pour votre aide

Regarde la pièce jointe 1170676

 

[sylvanu]

Bonjour Cbar,
Au risque d'être lourd, et de me répéter :

Des images n'ont jamais constitué un fichier réellement représentatif.

Pouvez vous fournir un fichier réellement représentatif ? On gagnera du temps.

Fournissez votre fichier anonymisé, on gagnera du temps. Comment voulez vous tester votre macro avec une PJ qui ne ressemble pas au besoin.
( PS : pour le code, utilisez la balise </> à droite de l'icone GIF, c'est beaucoup plus lisible )

 

[cbar]

Bonjour Cbar,
Au risque d'être lourd, et de me répéter :


Fournissez votre fichier anonymisé, on gagnera du temps. Comment voulez vous tester votre macro avec une PJ qui ne ressemble pas au besoin.
( PS : pour le code, utilisez la balise </> à droite de l'icone GIF, c'est beaucoup plus lisible )

Oui bien sûr désolé pas l'habitude de ce genre de pratique

 

[sylvanu]

Re,
Dans votre PJ initiale il n'y avait rien sous le tableau, donc on trouve la dernière ligne avec :

DL = [A65500].End(xlUp).Row

Or maintenant il y a plein de chose sous le tableau, et donc DL=205, la première ligne non vide en partant de la fin.
... donc ça ne marche plus.
En PJ on part de la ligne 80 et en descendant on cherche le chapitre VII, ce qui donne la fin du tableau.

L = 80
While Left(Cells(L, 1), 3) <> "VII" ' Recherche du chapitre VII.Etat de Conservation des Matériaux...
    DL = L
    L = L + 1
Wend
DL = DL - 1                         ' Calcul de la fin du tableau

NB : Sans PJ c'était impossible à détecter, car lié à votre contexte.

 

[cbar]

Re,
Dans votre PJ initiale il n'y avait rien sous le tableau, donc on trouve la dernière ligne avec :

DL = [A65500].End(xlUp).Row

Or maintenant il y a plein de chose sous le tableau, et donc DL=205, la première ligne non vide en partant de la fin.
... donc ça ne marche plus.
En PJ on part de la ligne 80 et en descendant on cherche le chapitre VII, ce qui donne la fin du tableau.

L = 80
While Left(Cells(L, 1), 3) <> "VII" ' Recherche du chapitre VII.Etat de Conservation des Matériaux...
    DL = L
    L = L + 1
Wend
DL = DL - 1                         ' Calcul de la fin du tableau

NB : Sans PJ c'était impossible à détecter, car lié à votre contexte.

Merci sylvanu pour votre retour et chapeau pour votre maitrise des macros
Vous avez bien compris que je suis un super débutant novice en la matière.
Assez travaillé pour aujourd'hui , je prendrais le temps demain de tester votre macro avec des essais de 1 à 12 pièces. Bien sûr je ne manquerais de votre tenir au courant.
En attendant bonne soirée.

 

[cbar]

Re,
Dans votre PJ initiale il n'y avait rien sous le tableau, donc on trouve la dernière ligne avec :

DL = [A65500].End(xlUp).Row

Or maintenant il y a plein de chose sous le tableau, et donc DL=205, la première ligne non vide en partant de la fin.
... donc ça ne marche plus.
En PJ on part de la ligne 80 et en descendant on cherche le chapitre VII, ce qui donne la fin du tableau.

L = 80
While Left(Cells(L, 1), 3) <> "VII" ' Recherche du chapitre VII.Etat de Conservation des Matériaux...
    DL = L
    L = L + 1
Wend
DL = DL - 1                         ' Calcul de la fin du tableau

NB : Sans PJ c'était impossible à détecter, car lié à votre contexte.

Bonjour sylvanu,
J'ai testé la macro avec différents nombre de pièces, très bien pour le masquage de celulles vides mais quelques anomalies de fusion :
- le niveau ne se fusionne pas (colonne B du tableau)
- pas toutes les cellules ne se fusionnent pour les revêtrement murs, plafond et sol.
Je te renvoi le fichier avec l'onglet "BD" (base de données). Pour faire des essais il suffit de saisir ou supprimer le chiffre de la colonne "Ref" en sachant qu'ils doivent être en ordre chronologique.
Je tiens raiment a vous remercier pour votre aide
Bonne journée cbar

 

[sylvanu]

Bonjour Cbar,
Effectivement "ya une coquille" ! Sorry.
En fait tout vient encore de DL.
Donc j'ai repris le code initial, et au début je calcule le "vrai" DL c'est à dire 2 lignes avant le chapitre VII, puis ensuite j'applique le code initial, et ça a l'air de marcher.... mais à vérifier.

 

[cbar]

Bonjour Cbar,
Effectivement "ya une coquille" ! Sorry.
En fait tout vient encore de DL.
Donc j'ai repris le code initial, et au début je calcule le "vrai" DL c'est à dire 2 lignes avant le chapitre VII, puis ensuite j'applique le code initial, et ça a l'air de marcher.... mais à vérifier.

Bonsoir sylvanu,
J'ai fait des essais un peu dans tous les sens et ça marche impeccable
Trop content que vous m'ayez si bien aidé
Je met la discussion résolue
Merci encore
cbar

 

[cbar]

Bonsoir sylvanu,
J'ai fait des essais un peu dans tous les sens et ça marche impeccable
Trop content que vous m'ayez si bien aidé
Je met la discussion résolue
Merci encore
cbar

Bonjour sylvanu,
Je reviens vers toi pour le même fichier.
On me fait remarquer qu'à l'exécution de la macro "Sub D_AmianteTabRevetements()" certaines lignes fusionnées se centrent ou se defusionnent et ce à partir de la ligne 7.
En faite, la macro ne doit intervenir que de la ligne 80 à 91.
Je ne sais pas corriger ta macro, je ne connais rien en code tout juste enregistrer des macros
Si tu peux corriger ce petit , un grand merci
cbar

 

[sylvanu]

Bonjour Cbar,
Essayez avec :

Sub Assemble(DL, Colonne)
Items = Cells(80, Colonne): L1 = 80: L2 = 80
For L = 80 To DL
    If Cells(L, Colonne) <> "" And Cells(L, Colonne) = Items Then
        L2 = L
    Else
        With Range(Cells(L1, Colonne), Cells(L2, Colonne + 2))
            .MergeCells = True
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
        Items = Cells(L, Colonne): L1 = L: L2 = L1
    End If
Next L
End Sub
Sub Assemble2(DL)
Items = Cells(80, 2): L1 = 80: L2 = 80
For L = 80 To DL
    If Cells(L, 2) <> "" And Cells(L, 2) = Items Then
        L2 = L
    Else
        With Range(Cells(L1, 2), Cells(L2, 2))
            .MergeCells = True
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
        Items = Cells(L, 2): L1 = L: L2 = L1
    End If
Next L
End Sub

Je ne sais pas pourquoi ce 7 est présent au lieu de 80. Une coquille.

 

[cbar]

Bonjour Cbar,
Essayez avec :

Sub Assemble(DL, Colonne)
Items = Cells(80, Colonne): L1 = 80: L2 = 80
For L = 80 To DL
    If Cells(L, Colonne) <> "" And Cells(L, Colonne) = Items Then
        L2 = L
    Else
        With Range(Cells(L1, Colonne), Cells(L2, Colonne + 2))
            .MergeCells = True
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
        Items = Cells(L, Colonne): L1 = L: L2 = L1
    End If
Next L
End Sub
Sub Assemble2(DL)
Items = Cells(80, 2): L1 = 80: L2 = 80
For L = 80 To DL
    If Cells(L, 2) <> "" And Cells(L, 2) = Items Then
        L2 = L
    Else
        With Range(Cells(L1, 2), Cells(L2, 2))
            .MergeCells = True
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
        Items = Cells(L, 2): L1 = L: L2 = L1
    End If
Next L
End Sub

Je ne sais pas pourquoi ce 7 est présent au lieu de 80. Une coquille.

Merci nickel
congratulations