Fusion de cellules avec macro et mfc

[liloun43]

Bonjour,

Je vais essayer de me faire comprendre..

J'ai des données brute sous excel qui viennent d'un export d'un autre logiciel, en sachant que le nombre de ligne varie, à laide d'une macro je souhaite fusionner toutes les cellules identiques (colonne A,B,C...) en fonction que le chiffre en colonne D est identiques.

De plus pour les colonne G, H et I je souhaite qu'elle se fusionne en fonction de la colonne H..

Suite a cela, j'ai une mise en forme conditionnelle qui colore en vert toutes les colonnes de de A à W si le colonne W est remplie.

Le problème est qu'au niveau de mes colonnes G, H et I je n'ai que la 1ere ligne qui se colorie (je voudrais que toutes les cellules en G,Het I associé a la colonne D se colorie aussi)

Merci pour votre, je vous joins le fichier excel

Cordialement,

 

[liloun43]

Re : Fusion de cellules avec macro et mfc

Voila ou en est ma macro..


Mise en forme conditonnelle
'
Range("A2:W2").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=NON(ESTVIDE($W2))"
Selection.FormatConditions(1).Interior.ColorIndex = 35
ActiveWindow.SmallScroll ToRight:=19
Range("X2:AA2").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=NON(ESTVIDE($AA2))"
Selection.FormatConditions(1).Interior.ColorIndex = 35
ActiveWindow.SmallScroll ToRight:=4
Range("AB2").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotEqual, _
Formula1:="0"
Selection.FormatConditions(1).Interior.ColorIndex = 35

Range("AC2").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=AC2>AUJOURDHUI()"
Selection.FormatConditions(1).Interior.ColorIndex = 36
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=ET(AC2<>0;AC3<AUJOURDHUI())"
Selection.FormatConditions(2).Interior.ColorIndex = 35

Range("AD2").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=NON(ESTVIDE($AD2))"
Selection.FormatConditions(1).Interior.ColorIndex = 35
Range("AE2").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=NON(ESTVIDE($AE2))"
Selection.FormatConditions(1).Interior.ColorIndex = 35
Range("AF2").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotEqual, _
Formula1:="0"
Selection.FormatConditions(1).Interior.ColorIndex = 35
Range("AG2").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=NON(ESTVIDE($AG2))"
Selection.FormatConditions(1).Interior.ColorIndex = 35
Range("AH2").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=NON(ESTVIDE($AH2))"
Selection.FormatConditions(1).Interior.ColorIndex = 35
Range("AI2").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=NON(ESTVIDE($AI2))"
Selection.FormatConditions(1).Interior.ColorIndex = 35

Range("AJ2").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotEqual, _
Formula1:="0"
Selection.FormatConditions(1).Interior.ColorIndex = 35

Range("A2:AJ2").Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

'fusion des propriété

Dim i As Long, j As Long, H As Long, k As Long
Application.DisplayAlerts = False 'désactive la boîte de dialogue de la fusion
'étude colonne C (3)(code propriété) pour fusion des propriétés
For i = 1 To Range("C65536").End(xlUp).Row - 1
j = i + 1
While Cells(j, 4) = Cells(i, 4)
'Fusion des colonnes se rapportant à la propriété
Range(Cells(i, 1), Cells(j, 1)).MergeCells = True
Range(Cells(i, 2), Cells(j, 2)).MergeCells = True
Range(Cells(i, 3), Cells(j, 3)).MergeCells = True
Range(Cells(i, 4), Cells(j, 4)).MergeCells = True
Range(Cells(i, 5), Cells(j, 5)).MergeCells = True
Range(Cells(i, 6), Cells(j, 6)).MergeCells = True
Range(Cells(i, 10), Cells(j, 10)).MergeCells = True
Range(Cells(i, 11), Cells(j, 11)).MergeCells = True
Range(Cells(i, 12), Cells(j, 12)).MergeCells = True
Range(Cells(i, 13), Cells(j, 13)).MergeCells = True
Range(Cells(i, 14), Cells(j, 14)).MergeCells = True
Range(Cells(i, 15), Cells(j, 15)).MergeCells = True
Range(Cells(i, 16), Cells(j, 16)).MergeCells = True
Range(Cells(i, 17), Cells(j, 17)).MergeCells = True
Range(Cells(i, 18), Cells(j, 18)).MergeCells = True
Range(Cells(i, 19), Cells(j, 19)).MergeCells = True
Range(Cells(i, 20), Cells(j, 20)).MergeCells = True
Range(Cells(i, 21), Cells(j, 21)).MergeCells = True
Range(Cells(i, 22), Cells(j, 22)).MergeCells = True
Range(Cells(i, 23), Cells(j, 23)).MergeCells = True
Range(Cells(i, 24), Cells(j, 24)).MergeCells = True
Range(Cells(i, 25), Cells(j, 25)).MergeCells = True
Range(Cells(i, 26), Cells(j, 26)).MergeCells = True
Range(Cells(i, 27), Cells(j, 27)).MergeCells = True
Range(Cells(i, 28), Cells(j, 28)).MergeCells = True
Range(Cells(i, 29), Cells(j, 29)).MergeCells = True
Range(Cells(i, 30), Cells(j, 30)).MergeCells = True
Range(Cells(i, 31), Cells(j, 31)).MergeCells = True
Range(Cells(i, 32), Cells(j, 32)).MergeCells = True
Range(Cells(i, 33), Cells(j, 33)).MergeCells = True
Range(Cells(i, 34), Cells(j, 34)).MergeCells = True
Range(Cells(i, 35), Cells(j, 35)).MergeCells = True
Range(Cells(i, 36), Cells(j, 36)).MergeCells = True
Range(Cells(i, 37), Cells(j, 37)).MergeCells = True
Range(Cells(i, 38), Cells(j, 38)).MergeCells = True

j = j + 1
Wend
'étude colonne H (8)(parcelle) pour fusion des immeubles
For H = i To j - 2
k = H + 1
While Cells(k, 8) = Cells(H, 8) And k < j
'Fusion des colonnes se rapportant à la location et au terrier
Range(Cells(H, 7), Cells(k, 7)).MergeCells = True
Range(Cells(H, 8), Cells(k, 8)).MergeCells = True
Range(Cells(H, 9), Cells(k, 9)).MergeCells = True

k = k + 1
Wend
H = k - 1
Next H
i = j - 1
Next i
Application.DisplayAlerts = True 'réactive les boîtes de dialogue
End Sub