Macro condition si cellule fusionnée dans une colonne

[jeanmomo]

Bonjour à tous,

Je poste ce sujet à défaut d'avoir trouvé la solution sur internet (et par moi même).
Cela fait deux jours que je monte un projet d'automatisation, et il ne me reste plus qu'une étape à mettre en place.


Dans un onglet excel, il se peut que j'ai la configuration suivante :

A10 et A11 fusionnée (si je défusionne, la valeur se retrouve en A10, soit BLABLA cette valeur),
avec des valeurs en B10 (soit VALB10 cette valeur) et B11 (soit VALB11 cette valeur), et des valeurs en C11, D11, E11, mais pas de valeur en C10, D10 ni E10.

Je souhaite trouver un code qui me permette d'avoir comme résultat :

A11 = BLABLA
B11 = VALB10&" "&VALB11
avec C11, D11 et E11 inchangées
et enfin que la ligne 10 soit supprimée.


Pour apporter plus de précision, les cellules fusionnées de mon tableau ne se trouvent que dans la colonne A (donc il n'y a que dans cette colonne que je dois faire le test, disons de A1 à A65000, ou alors de A1 à la dernière cellule non vide de la colonne A.


Enfin, il se peut que j'ai également la même situation avec trois cellules côte à côte en colonne A fusionnée, mais je pense pouvoir adapter le code que j'espère vous arriverez à me proposer avec cette éventualité.



Un grand merci par avance aux personnes qui me viendront en aide !!!!!

 

[Dranreb]

Re : Macro condition si cellule fusionnée dans une colonne

Bonjour.
Pour supprimer des lignes, commencer par la fin.
Lors de la boucle, étudier, grâce à l'aide, comment utiliser les propriétés MergeCells et MergeArea et les méthodes Merge et UnMerge.

 

[jeanmomo]

Re : Macro condition si cellule fusionnée dans une colonne

Voici un fichier exemple (dans mon cas, le nombre de ligne peut-être bien plus important), en espérant que ça puisse aider à mieux comprendre ma problèmatique.

 

[Dranreb]

Re : Macro condition si cellule fusionnée dans une colonne

À essayer :

Sub SupprimerLignes()
Dim Plg As Range, L As Long, Fus As Range, NFus As Range
Set Plg = ActiveSheet.UsedRange
Set Fus = Plg.Rows(Plg.Rows.Count + 1)
Application.DisplayAlerts = False
For L = Plg.Rows.Count To 2 Step -1
                Plg(L, 3).Resize(, 3).Select
   Set NFus = Plg(L, 1).MergeArea
   If NFus.Row < Fus.Row Then
      On Error Resume Next: If Fus.Rows.Count > 1 Then Fus.Merge
      On Error GoTo 0: Set Fus = NFus
      If Fus.MergeCells Then Fus.UnMerge: Fus.Value = Fus(1, 1).Value
      End If
   If WorksheetFunction.CountA(Plg(L, 3).Resize(, 3)) = 0 Then
      Plg.Rows(L).EntireRow.Delete
      End If
   Next L
If Fus.Rows.Count > 1 Then Fus.Merge
Application.DisplayAlerts = True
End Sub

 

[jeanmomo]

Re : Macro condition si cellule fusionnée dans une colonne

Merci pour ta réponse Dranreb,

Même si le code fonctionne, celà ne répond pas exactement à mes attentes.
En effet, dans le travail de retraitement que je souhaite opérer, je suis déjà parvenu à insérer/supprimer des lignes quand celà était nécessaire, dupliquer des formules, etc, mais le problème que je souhaite résoudre est celui des infos présentées sur deux lignes (avec à chaque fois la cellule en colonne A qui est fusionnée).

Afin d'être plus clair sur le résultat que je souhaite obtenir, je joins un fichier avec le fichier de base, et dans le deuxième onglet le résultat que je souhaite obtenir, avant de faire toutes les autres manipulations que j'ai déjà programmées.

Pour ce qui est des lignes en jaune, j'arriverai à les supprimer par moi même, mon unique soucis étant de passer de deux lignes à une ligne lorsque l'information est présentée sur deux lignes.

J'espère avoir été suffisament précis, et j'espère que tu pourras me trouver une solution.

 

[Dranreb]

Re : Macro condition si cellule fusionnée dans une colonne

Mais êtes vous sûr que votre exemple couvre tous les seuls cas possible ?
Car ceci, plus simple, donne le bon résultat avec :

Sub SupprimerLignes2()
Dim Plg As Range, L As Long
Set Plg = ActiveSheet.UsedRange
For L = Plg.Rows.Count To 2 Step -1
   If Plg(L, 1).MergeCells And Plg(L, 1).MergeArea.Row = Plg.Rows(L).Row Then
      Plg(L, 1).MergeArea.UnMerge
      Plg(L + 1, 1).Value = Plg(L, 1).Value
      Plg(L + 1, 2).Value = Plg(L, 2).Value & " " & Plg(L + 1, 2).Value
      Plg.Rows(L).EntireRow.Delete
      End If
   Next L
End Sub

 

[jeanmomo]

Re : Macro condition si cellule fusionnée dans une colonne

C'est parfait !!!!

Un grand merci Danreb d'avoir pris de ton temps pour me venir en aide !!!

 

[jeanmomo]

Re : Macro condition si cellule fusionnée dans une colonne

Danreb,

Comme discuté ce matin par MP, voici ci-joint un fichier exemple avec les deux cas de figure que je rencontre, et les résultats souhaités.

Pour rappel, ta solution pour le cas n°1 marche à la perfection.
L'idéal serait un code permettant d'arriver aux résultats souhaités quelque soit le cas (en gros il me faut sur la même ligne les infos pour les 6 colonnes que se soit sur la ligne du haut ou celle du bas).

Mais, un code permettant d'arriver au cas de figure n°2 serait déjà formidable


Encore merci pour ton aide très très précieuse !!!

Cordialement.

 

[Dranreb]

Re : Macro condition si cellule fusionnée dans une colonne

Bonsoir.
D'après vos modèles de résultats souhaités, ne doivent elles pas disparaître les lignes où, derrière une cellule fusionnée en A, aucune des 4 colonnes de droite n'est renseignée ?

 

[jeanmomo]

Re : Macro condition si cellule fusionnée dans une colonne

Bonsoir Danreb,

En effet c'est exactement ça, mais j'ai réussit à "bricoler" un code me permettant de faire les retraitements qui me sont nécessaires ensuite.

Mon unique soucis consiste dans le cas n°2, cas de figure de présentation du fichier original brut que je reçois, pour lequel je souhaite donc que la boucle que vous m'aviez trouvée soit adaptée.

En vous remerciant encore une fois.

Cordialement.



Pour info, voici ce code, qui fera sans doute bondir au plafond les puristes du forum , mais le principal étant qui fonctionne:

submacroforum
Dim nblignes As String
Dim cel As Range, ins As Range

Dim DernLigne As Long

Application.ScreenUpdating = False

Range("B65536").End(xlUp).Offset(1, 0).Select

ActiveCell.Offset(0, 6).Select

ActiveCell.FormulaR1C1 = "lastligne"

Dim Plg As Range, L As Long
Set Plg = ActiveSheet.UsedRange
For L = Plg.Rows.Count To 2 Step -1
If Plg(L, 1).MergeCells And Plg(L, 1).MergeArea.Row = Plg.Rows(L).Row Then
Plg(L, 1).MergeArea.UnMerge
Plg(L + 1, 1).Value = Plg(L, 1).Value
Plg(L + 1, 2).Value = Plg(L, 2).Value & " " & Plg(L + 1, 2).Value
Plg.Rows(L).EntireRow.Delete
End If
Next L

Range("C4").Select
Selection.Copy
Range("C5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D3").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=R[1]C&"" ""&R[2]C&"" ""&R[3]C"
Range("D3").Select
Selection.Copy
Range("E3").Select
ActiveSheet.Paste
Range("F3").Select
ActiveSheet.Paste
Range("D3:F3").Select
Application.CutCopyMode = False
Selection.Copy
Range("D5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D6:F6").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("D3:F3").Select
Selection.ClearContents
Range("C4").Select
Selection.ClearContents
nblignes = Range("G1", [G1].End(xlDown)).Rows.Count
Cells.Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

Columns("A:A").Select
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With

Range("G1").Select
ActiveCell.FormulaR1C1 = "=R1C1"
Range("G2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-4]="""",""OK"",""NOT"")"
Range("G2").Select
Selection.Copy

[G2].AutoFill Destination:=Range("G2:G" & Range("B65536").End(xlUp).Row)

ActiveSheet.Range("G2:G" & Range("B65536").End(xlUp).Row).AutoFilter Field:=1, Criteria1:="=OK", _
Operator:=xlAnd

[G3:G65000].SpecialCells(xlCellTypeVisible).EntireRow.Delete

Cells.Select
Selection.AutoFilter
Range("G1").Select
ActiveCell.FormulaR1C1 = "=R1C1"
Range("G2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-6]="""",""OK"",""NOT"")"
Range("G2").Select
Selection.Copy

[G2].AutoFill Destination:=Range("G2:G" & Range("B65536").End(xlUp).Row)

ActiveSheet.Range("G1:G" & Range("B65536").End(xlUp).Row).AutoFilter Field:=1, Criteria1:="=OK", _
Operator:=xlAnd

[G2:G65000].SpecialCells(xlCellTypeVisible).EntireRow.Delete

Cells.Select
Selection.AutoFilter
Range("G2").Select
ActiveCell.FormulaR1C1 = "=IF(OR(RC[-6]=""CCY"",RC[-6]=""DEVISE""),""OK"",""NOT OK"")"
Range("G2").Select
Selection.Copy

[G2].AutoFill Destination:=Range("G2:G" & Range("B65536").End(xlUp).Row)

ActiveSheet.Range("G1:G" & Range("B65536").End(xlUp).Row).AutoFilter Field:=1, Criteria1:="=OK", _
Operator:=xlAnd

[G2:G65000].SpecialCells(xlCellTypeVisible).EntireRow.Delete

Cells.Select
Selection.AutoFilter

 

[Dranreb]

Re : Macro condition si cellule fusionnée dans une colonne

Mais dans ce code la première ligne est supprimée, celle où les 4 colonnes étaient vides dans le 1er cas. Vous me confirmez que vous ne voulez plus supprimer la ligne où elles sont vides ?

 

[jeanmomo]

Re : Macro condition si cellule fusionnée dans une colonne

Arf.... je ne suis pas sur de saisir à 100% votre dernier commentaire.

Le fichier exemple montrait le résultat que devait prendre mes données une fois l'action de la boucle effectuée.

Je vous joint à nouveau le fichier avec un onglet "récap" qui est le résultat que je souhaite obtenir au final (résultat que j'obtiens déjà dans le cas n°1 grace à votre aide).


Il est possible que certains points de mon code vous interpelle car dans le classeur exemple, certaines problématiques ne sont pas reprises.

L'unique difficulté, et non des moindres est de permettre de fusionnées les "valeur x" et "valeur y" dans la 2ème colonne, et que sur la même ligne où apparaît ce libellé fusionné, soient gardées les informations des colonnes n°1, 3, 4 et 6.

Si jamais vous ne trouvez pas le moyen de créer un unique code, une mise à jour du premier me permettant de régler le cas n°2 serait déjà PLUS QUE PARFAIT.


Encore merci.

 

[Dranreb]

Re : Macro condition si cellule fusionnée dans une colonne

Mais nom d'une pipe, allez vous répondre à ma question ? Pourquoi reste-t-il toujours dans vos modèles de résultats souhaités une ligne inutile jaune avec juste "test" en colonne A et le reste vide ? Est-ce voulu ?
Allez je la supprime, car c'est plus simple pour moi :

Sub SupprimerLignes()
Dim Plg As Range, LDéb As Long, L As Long, Fus As Range, Int1 As String, Int2 As String, LFu As Long
Set Plg = ActiveSheet.UsedRange
LDéb = Plg.Rows(Plg.Rows.Count + 1).Row
For L = Plg.Rows.Count To 2 Step -1
   If Plg(L, 1).MergeCells Then
      Set Fus = Plg(L, 1).MergeArea: LDéb = Fus.Row: Fus.UnMerge
      Int1 = Plg(LDéb, 1).Value
      Int2 = Plg(LDéb, 2).Value: For LFu = LDéb + 1 To L: Int2 = Int2 & " " & Plg(LFu, 2).Value: Next LFu: End If
   If L >= LDéb Then
      If WorksheetFunction.CountA(Plg(L, 3).Resize(, 4)) = 0 Then
         Plg.Rows(L).EntireRow.Delete
      Else
         Plg(L, 1).Value = Int1: Plg(L, 2).Value = Int2: End If: End If: Next L
End Sub

Et dans votre résultat final c'est encore autre chose: vous supprimez aussi les ligne où il n'y a rien en colonne A. Ça pourrait se faire Comme ça :

Sub SupprimerLignes()
Dim Plg As Range, LDéb As Long, L As Long, Fus As Range, Int1 As String, Int2 As String, LFu As Long
Set Plg = ActiveSheet.UsedRange
LDéb = Plg.Rows(Plg.Rows.Count + 1).Row
For L = Plg.Rows.Count To 2 Step -1
   If Plg(L, 1).MergeCells Then
      Set Fus = Plg(L, 1).MergeArea: LDéb = Fus.Row: Fus.UnMerge
      Int1 = Plg(LDéb, 1).Value
      Int2 = Plg(LDéb, 2).Value: For LFu = LDéb + 1 To L: Int2 = Int2 & " " & Plg(LFu, 2).Value: Next LFu: End If
   If L >= LDéb Then
      If WorksheetFunction.CountA(Plg(L, 3).Resize(, 4)) = 0 Then
         Plg.Rows(L).EntireRow.Delete
      Else
         Plg(L, 1).Value = Int1: Plg(L, 2).Value = Int2: End If
   ElseIf IsEmpty(Plg(L, 1).Value) Then
      Plg.Rows(L).EntireRow.Delete: End If: Next L
End Sub

 

[jeanmomo]

Re : Macro condition si cellule fusionnée dans une colonne

Vous êtes un génie !!!!!! Mais je ne dois être le premier à vous le dire

J'ai cru déceler une petite faille par rapport à l'ensemble des retraitements que je dois opérer, mais la dite faille vient d'un "nouveau cas de figure" que je n'avais jusqu'alors pas déceler. Mais rien de bien méchant, je devrais parvenir à m'en défaire.

Pour répondre à votre question que j'ai enfin compris, j'ai laissé cette ligne dans mon exemple car je parviens à la supprimer par la suite avec mon code, je n'ai pas pensé que celà pouvait vous déranger.

Je vous remercie donc à nouveau pour votre aide plus que précieuse, et vous libère à vos autres occupations

Cordialement.