XL 2021 vba fusion lignes et colonnes pour cellules identiques

cbar

XLDnaute Nouveau
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

1684760279148.png
1684759871742.png

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
 

Pièces jointes

  • EssaiVbaFusion.xlsx
    34.1 KB · Affichages: 10
Solution
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

Gégé-45550

XLDnaute Accro
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

Regarde la pièce jointe 1170680 Regarde la pièce jointe 1170679
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
Bonjour,
Vous évoquez un tableau qui contient des champs calculés.
À partir de là, il n'y a, à ma connaissance, aucune solution Excel pour fusionner des cellules contiguës donnant un résultat identique, idem pour le masquage des cellules vides.
Seul un développement VBA complexe peut éventuellement permettre d'obtenir le résultat que vous escomptez.
Je doute que vous trouviez ici quelqu'un qui voudra passer beaucoup plus de temps que le temps que vous consacrez à la dizaine de vos manipulations quotidiennes pour en écrire le code et le tester ... mais qui sait ?
Cordialement,
 

cbar

XLDnaute Nouveau
Bonjour Cbar, et bienvenu sur XLD,
Please, pour les vieux, conservez une police plus grande, ce sera plus lisible. :)
En PJ un essai avec ce que j'ai compris.
sylvanu bravo t'es champion, exatement ce que je voulais
Ça marche impecable, merci beaucoup pour ta macro 👏
Tu va me faire gagner un temps précieux
Sans vouloir abuser, si tu peux faire la même chose pour la colonne B
🤩
 

cbar

XLDnaute Nouveau
Oui manuellement, mais au départ lorsque je commence a travailler sur un dossier toutes les cellules sont défusionnées avec dans chacune d'elles une formule et elles se remplissent avec les infos du nouveau dossier.
Si je me suis bien fait comprendre :rolleyes:
 

cbar

XLDnaute Nouveau
Testez ça, au pif.
Bonjour sylvanu, tout d'abord t'informer que mes problèmes Excel sont résolus (clé de licence et fichiers en lecture seule), il manquait un fichier utilitaire.

Pour revenir à la super macro que vous m'avez envoyé et que j'ai essayé d'adapter au fichier d'origine.
J'ai dû faire une mauvaise saisie. La macro masque les lignes de 88 à 206 alors que j'ai besoin de masquer de la 1ère ligne vide du tableau jusqu'à la ligne 91 si vide.
Vous pouvez m'aider à corriger
1685442949840.png
1685442924867.png

Sub AmianteTabRevetements()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
DL = [A65500].End(xlUp).Row
Assemble DL, 8
Assemble DL, 11
Assemble DL, 14
Assemble2 DL
Application.DisplayAlerts = True
For L = 81 To DL + 1
If Cells(L, "A") <> 1 + Cells(L - 1, "A") Then Exit For
Next L
Range("A" & L & ":A" & DL + 1).EntireRow.Hidden = True
End Sub
Sub Assemble(DL, Colonne)
Items = Cells(80, Colonne): L1 = 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
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

Un grand merci
cbar
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 910
Membres
101 837
dernier inscrit
Ugo