Fusion automatique conditionnée

PièceJointe

XLDnaute Nouveau
bonsoir à tous...

J'avais initialement posté à la suite d'un fil qui me semblait approprié mais le silence général me dit que je n'ai peut être pas bien fait...

je vient de mettre le nez dans les macro et dans vba... c'est pas simple... voici ce que je souhaite faire :

je souhaite fusionner automatiquement des cellules identiques dans des colonnes identifiées (c'est à dire uniquement dans les colonnes de mon choix : ici les colonnes F K et M et uniquement pour des cellules adjacentes verticalement).

En cadeau bonux, s'il était possible, je souhaiterai que cela se fasse dans une autre feuille afin de conserver la possibilité de trier et de calculer comme bon me semble dans le fichier "source"...

j'ai tenté ce code proposé dans un ancien post sans succès :

'Mes valeurs sont dans la colonne A
Dim Deb As Long

Range("A1").Select
Application.DisplayAlerts = False
Deb = -1
While Not IsEmpty(ActiveCell)
If ActiveCell.Value = ActiveCell.Offset(1).Value Then
If Deb = -1 Then Deb = ActiveCell.Row
Else
If Deb <> -1 Then
With Range("A" & Deb & ":A" & ActiveCell.Row)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.MergeCells = True
End With
Deb = -1
End If
End If
ActiveCell.Offset(1).Select
Wend
Application.DisplayAlerts = True




et celle ci aussi...mais visiblement il y a une "erreur de compilation /erreur de syntaxe" à la ligne :
C1 = Range('A' & i) = Range('B' & i)


Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 06/02/2006 par ADSLHY
'

'
Application.ScreenUpdating = False 'fige l'affichage de l'écran
Application.EnableEvents = False 'Supprime certain message d'alerte windows


For i = 2 To 10 'choisissez de quelle ligne a quel ligne doit ce faire les fusion

'C1 & C2 sont les condition qui permettent de savoir si An=Bn et si Bn=Cn
C1 = Range('A' & i) = Range('B' & i)
C2 = Range('B' & i) = Range('C' & i)

If (C1 = True And C2 = True) Then 'si C1 et C2 sont vrai alors fusion cellule ABCn
Range('B' & i, 'C' & i).Select
Selection.ClearContents
Range('A' & i, 'C' & i).Select 'selection An;Cn
With Selection 'fusion
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Selection.Merge
End If
Next i
Application.ScreenUpdating = True

Application.EnableEvents = True

End Sub



Je me repère vaguement dans le code mais en fait j'y comprends rien... Je suis prêt à passer le week end dessus, je vous demande pas un truc tout cuit (quoique je prendrai)...au moins une idée...je suis hyper mal barré et je dois rendre ma copie mardi... Help :)

En Pièce Jointe un exemple de ce sur quoi je travaille...anonymé et réduit à quelques lignes...

Merci de vos conseils...
 

Pièces jointes

  • TEST Fusion1.xls
    37.5 KB · Affichages: 72
  • TEST Fusion1.xls
    37.5 KB · Affichages: 70
  • TEST Fusion1.xls
    37.5 KB · Affichages: 70

tototiti2008

XLDnaute Barbatruc
Re : Fusion automatique conditionnée

Bonjour PièceJointe,

un petit code pour la colonne F, pour t'inspirer :


Code:
Debut = 7
Valo = Worksheets("Général").Range("F7").Value
For i = 8 To Worksheets("Général").Range("F65536").End(xlUp).Row +1
    If Worksheets("Général").Range("F" & i).Value <> Valo  Then
        Application.DisplayAlerts = False
        With Worksheets("Général").Range("F" & Debut & ":F" & i - 1)
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .Merge
        End With
        Debut = i
        Valo = Worksheets("Général").Range("F" & i).Value
    End If
Next i
 

PièceJointe

XLDnaute Nouveau
Re : Fusion automatique conditionnée

merci bcp... mais ça marche pas mieux..."la méthode défault a échoué" erreur 1004... je pense que ça te parle plus qu'à moi....

xls 2004 pour mac...

il manque peut être une partie de code...je me suiis contenté d'inserer le tien... ça donne ça :

Code:
Sub Macro1()
'
' Debut = 7
Valo = Worksheets("Général").Range("F7").Value
For i = 8 To Worksheets("Général").Range("F65536").End(xlUp).Row + 1
    If Worksheets("Général").Range("F" & i).Value <> Valo Then
        Application.DisplayAlerts = False
        With Worksheets("Général").Range(Cells(Debut, 6), Cells(i - 1, 6))
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .Merge
        End With
        Debut = i
        Valo = Worksheets("Général").Range("K" & i).Value
    End If
Next i
Application.ScreenUpdating = True

Application.EnableEvents = True

End Sub
 

tototiti2008

XLDnaute Barbatruc
Re : Fusion automatique conditionnée

efface l'apostrophe devant

' Debut = 7

et remet la ligne comme ça, je préfère,

With Worksheets("Général").Range("F" & Debut & ":F" & i - 1)

et à la place de

Valo = Worksheets("Général").Range("K" & i).Value

met

Valo = Worksheets("Général").Range("F" & i).Value

et efface les 2 lignes :

Application.ScreenUpdating = True

Application.EnableEvents = True
 
Dernière édition:

PièceJointe

XLDnaute Nouveau
Re : Fusion automatique conditionnée

pas facile mais intéressant...je sens que ça va me plaire....C'est des boucles en somme non ?

Code:
Sub Macro1()

Debut = 7
Valo = Worksheets("Général").Range("F" & i).Value
For i = 8 To Worksheets("Général").Range("F65536").End(xlUp).Row + 1
    If Worksheets("Général").Range("F" & i).Value <> Valo Then
        Application.DisplayAlerts = False
        With Worksheets("Général").Range("F" & Debut & ":F" & i - 1)
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .Merge
        End With
        Debut = i
        Valo = Worksheets("Général").Range("F" & i).Value
    End If
Next i
End Sub

ben là c'est cette ligne qui ressort du debog...
For i = 8 To Worksheets("Général").Range("F65536").End(xlUp).Row + 1
 

tototiti2008

XLDnaute Barbatruc
Re : Fusion automatique conditionnée

corrections :

Code:
Sub Macro1()
[COLOR=red]Dim Debut as long, i as long, Valo[/COLOR]
Debut = 7
Valo = Worksheets("Général").Range[COLOR=red]("F7").[/COLOR]Value
For i = 8 To Worksheets("Général").Range("F65536").End(xlUp).Row + 1
    If Worksheets("Général").Range("F" & i).Value <> Valo Then
        Application.DisplayAlerts = False
        With Worksheets("Général").Range("F" & Debut & ":F" & i - 1)
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .Merge
        End With
        [COLOR=red]Application.DisplayAlerts = True[/COLOR]
        Debut = i
        Valo = Worksheets("Général").Range("F" & i).Value
    End If
Next i
End Sub
 

PièceJointe

XLDnaute Nouveau
Re : Fusion automatique conditionnée

Toujours pas....
Code:
Valo = Worksheets("Général").Range("F7").Value
pose toujours pb...

Comment se fait il que cela fonctionne chez toi et pas ici ? grand mystère de l'informatique...

pour info je copie colle le code complet
Code:
Sub Macro1()
Dim Debut As Long, i As Long, Valo
Debut = 7
Valo = Worksheets("Général").Range("F7").Value
For i = 8 To Worksheets("Général").Range("F65536").End(xlUp).Row + 1
    If Worksheets("Général").Range("F" & i).Value <> Valo Then
        Application.DisplayAlerts = False
        With Worksheets("Général").Range("F" & Debut & ":F" & i - 1)
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .Merge
        End With
        Application.DisplayAlerts = True
        Debut = i
        Valo = Worksheets("Général").Range("F" & i).Value
    End If
Next i
End Sub
 

tototiti2008

XLDnaute Barbatruc
Re : Fusion automatique conditionnée

surtout que ça marche vraiment chez moi...
tu confirmes que tu testes bien sur le fichier que tu as posté plus haut ?

il est possible que la macro a tourné à moitié avant et que certaines cellules sont fusionnées en colonne F....

peux-tu vérifier, virer toutes les fusions existantes de la ligne 7 à la dernière et refaire tourner ?
 
Dernière édition:

PièceJointe

XLDnaute Nouveau
Re : Fusion automatique conditionnée

Bordel mais ça marche....j'ai repris le fichier tel que posté copier-coller ton code (le premier) et ça roule.... c'est génial !!!! Tu es génial !!! (et patient)...

J'imagine qu'il devait y avoir un souci avec une ancienne macro car j'ai effectivement travaillé sur mon fichier DD et non sur le posté au départ... purée... quel c...!

Enfin j'imagine que je n'ai qu'à dupliquer ce code en modifiant les variables à mois qu'il n'y ai un truc pour assigner telle, telle et telle colonne dans la même ligne de code...

Grand merci je teste avec les autres colonnes...

@+
 

Discussions similaires

Réponses
12
Affichages
268

Statistiques des forums

Discussions
312 767
Messages
2 091 920
Membres
105 104
dernier inscrit
jct