Fusionner automatiquement des cellules selon condition

Le
access13090
Bonjour à toute la communauté,

Je viens vers vous pour savoir s'il est possible via une macro ou vba
de fusionner automatiquement des cellules d'une feuille de calculs en
fonction des valeurs qu'elles contiennent ?

Actuellement, je le fais manuellement avec l'outil reproduire une mise
en forme et c'est long, sans compter les erreurs de manipulation. ;-)

Je travaille avec un tableau de 20 colonnes et 4 lignes. la lecture des
valeurs est verticale.

Un ordre d'idée. Les valeurs sont de type alphanumérique
- si mes 4 cellules contiennent la même valeur, il faudrait pouvoir
fusionner les 4 cellules et ne garder que la première valeur.
- si les 2 premières cellules contiennent une même valeur et les 2
dernières cellules une même autre valeur, pouvoir fusionner les 2
premières puis les 2 dernières
- si la première cellule contient une valeur ou est vide et que les 3
dernières contiennent une même autre valeur, pouvoir fusionner les 3
dernières cellules.
- et ainsi de suite avec toutes les autres permutations possibles.

Quelqu'un aurait-il une solution ? A condition que cela soit
réalisable.

Merci d'avance.
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
FFO
Le #16714081
Salut à toi
Soit l'onglet Feuil1 à traiter
Si le traitement commence à partir de la ligne 1 :

For Each c In Worksheets("Feuil1").Range("A1", Range("IV1").End(xlToLeft))
c.Activate
Application.DisplayAlerts = False
Départ = ActiveCell.Address
Do While ActiveCell.Row < 5
If ActiveCell <> ActiveCell.Offset(1, 0) Then
Range(Départ, ActiveCell.Address).Merge
Départ = ActiveCell.Offset(1, 0).Address
End If
ActiveCell.Offset(1, 0).Activate
Loop
Next

Si le traitement commence à partir de la ligne 2 :

For Each c In Worksheets("Feuil1").Range("A2", Range("IV2").End(xlToLeft))
c.Activate
Application.DisplayAlerts = False
Départ = ActiveCell.Address
Do While ActiveCell.Row < 6
If ActiveCell <> ActiveCell.Offset(1, 0) Then
Range(Départ, ActiveCell.Address).Merge
Départ = ActiveCell.Offset(1, 0).Address
End If
ActiveCell.Offset(1, 0).Activate
Loop
Next

Celà devrait convenir

Dis Moi !!!!
access13090
Le #16722701
Bonjour FFO,

Merci pour la solution.
Je ne sais pas du tout programmer. Où doit-on copier/coller la solution
? Faut-il placer un Sub() et End Sub() dans la solution ? A quoi
correspond le "c" dans For each ?
Sincèrement désolé pour ces questions.

Cordialement.

FFO a exprimé avec précision :
Salut à toi
Soit l'onglet Feuil1 à traiter
Si le traitement commence à partir de la ligne 1 :

For Each c In Worksheets("Feuil1").Range("A1", Range("IV1").End(xlToLeft))
c.Activate
Application.DisplayAlerts = False
Départ = ActiveCell.Address
Do While ActiveCell.Row < 5
If ActiveCell <> ActiveCell.Offset(1, 0) Then
Range(Départ, ActiveCell.Address).Merge
Départ = ActiveCell.Offset(1, 0).Address
End If
ActiveCell.Offset(1, 0).Activate
Loop
Next

Si le traitement commence à partir de la ligne 2 :

For Each c In Worksheets("Feuil1").Range("A2", Range("IV2").End(xlToLeft))
c.Activate
Application.DisplayAlerts = False
Départ = ActiveCell.Address
Do While ActiveCell.Row < 6
If ActiveCell <> ActiveCell.Offset(1, 0) Then
Range(Départ, ActiveCell.Address).Merge
Départ = ActiveCell.Offset(1, 0).Address
End If
ActiveCell.Offset(1, 0).Activate
Loop
Next

Celà devrait convenir

Dis Moi !!!!


FFO
Le #16723371
Rebonjour à toi

A partir du classeur à traiter :

Alt+F8
saisir le nom d'une Macro (Fusion par exemple)
Créer
Entre Sub Fusion() et End Sub recopier le code (le Premier si le traitement
doit être réalisé à partir de la ligne 1 sinon le second)
Fermer l'éditeur VBA
Le nom de l'onglet à traiter doit être "Feuil1" sinon il faut actualiser la
ligne de code :

For Each c In Worksheets("Feuil1").Range("A1", Range("IV1").End(xlToLeft))

ou la ligne

For Each c In Worksheets("Feuil1").Range("A2", Range("IV2").End(xlToLeft))

du nom de l'onglet ("Feuil1") avant la recopie dans l'éditeur VBA

Exécuter la macro

Donnes moi des nouvelles !!!!
access13090
Le #16733661
Bonjour FFO,

La procédure fonctionne semble-t-il en partie.

Soit un tableau qui s'étend sur la plage de C2:O10
Dans par exemple les plages C3:C6 et C7:C10 (puis D, E, F jusqu'à O)
je suis amené à saisir des valeurs alphanumériques qui sont pour la
plupart identiques.
Un exemple :
de C3:C6 je saisie la même valeur ABC1
de C7:C10 je saisie la même valeur RET5
de E5:E6 je saisie à nouveau la même valeur ABC1
de E8:E10 je saisie la même valeur FGH3
etc. avec toutes les combinaisons possibles.

Il faudrait dans la mesure où cela est réalisable que la procédure
puisse fusionner les paquets de cellules qui contiennent une même
valeur et d'afficher la valeur dans les cellules fusionnées.

J'espère exprimer correctement la problématique.

Cordialement.

FFO a exposé le 05/09/2008 :
Rebonjour à toi

A partir du classeur à traiter :

Alt+F8
saisir le nom d'une Macro (Fusion par exemple)
Créer
Entre Sub Fusion() et End Sub recopier le code (le Premier si le traitement
doit être réalisé à partir de la ligne 1 sinon le second)
Fermer l'éditeur VBA
Le nom de l'onglet à traiter doit être "Feuil1" sinon il faut actualiser la
ligne de code :

For Each c In Worksheets("Feuil1").Range("A1", Range("IV1").End(xlToLeft))

ou la ligne

For Each c In Worksheets("Feuil1").Range("A2", Range("IV2").End(xlToLeft))

du nom de l'onglet ("Feuil1") avant la recopie dans l'éditeur VBA

Exécuter la macro

Donnes moi des nouvelles !!!!


FFO
Le #16742311
Rebonjour à toi

Peux tu avec ce lien me transmettre un exemple sur 2 feuille :

L'une sans les cellules fusionner avec toutes les saisie l'autre avec les
cellules fusionner que l'on doit obtenir avec la macro

http://www.cijoint.fr/index.php

communiques le lien pour que je le récupère !!!!

"access13090" wrote:

Bonjour FFO,

La procédure fonctionne semble-t-il en partie.

Soit un tableau qui s'étend sur la plage de C2:O10
Dans par exemple les plages C3:C6 et C7:C10 (puis D, E, F jusqu'à O)
je suis amené à saisir des valeurs alphanumériques qui sont pour la
plupart identiques.
Un exemple :
de C3:C6 je saisie la même valeur ABC1
de C7:C10 je saisie la même valeur RET5
de E5:E6 je saisie à nouveau la même valeur ABC1
de E8:E10 je saisie la même valeur FGH3
etc. avec toutes les combinaisons possibles.

Il faudrait dans la mesure où cela est réalisable que la procédure
puisse fusionner les paquets de cellules qui contiennent une même
valeur et d'afficher la valeur dans les cellules fusionnées.

J'espère exprimer correctement la problématique.

Cordialement.

FFO a exposé le 05/09/2008 :
> Rebonjour à toi
>
> A partir du classeur à traiter :
>
> Alt+F8
> saisir le nom d'une Macro (Fusion par exemple)
> Créer
> Entre Sub Fusion() et End Sub recopier le code (le Premier si le traitement
> doit être réalisé à partir de la ligne 1 sinon le second)
> Fermer l'éditeur VBA
> Le nom de l'onglet à traiter doit être "Feuil1" sinon il faut actualiser la
> ligne de code :
>
> For Each c In Worksheets("Feuil1").Range("A1", Range("IV1").End(xlToLeft))
>
> ou la ligne
>
> For Each c In Worksheets("Feuil1").Range("A2", Range("IV2").End(xlToLeft))
>
> du nom de l'onglet ("Feuil1") avant la recopie dans l'éditeur VBA
>
> Exécuter la macro
>
> Donnes moi des nouvelles !!!!





access13090
Le #16745381
Bonsoir FFO,

Voici le lien http://cjoint.com/?jhrj0Uswnm contenant un classeur selon
tes instructions.

Cordialement

Dans son message précédent, FFO a écrit :
Rebonjour à toi

Peux tu avec ce lien me transmettre un exemple sur 2 feuille :

L'une sans les cellules fusionner avec toutes les saisie l'autre avec les
cellules fusionner que l'on doit obtenir avec la macro

http://www.cijoint.fr/index.php

communiques le lien pour que je le récupère !!!!


FFO
Le #16750851
Rebonjour à toi

J'ai bien analysé ton fichier

Contrairement à ce que tu avais annoncé ton tableau comporte 9 lignes et non
4 et 15 colonnes et non 20 ("Je travaille avec un tableau de 20 colonnes et 4
lignes. la lecture des valeurs est verticale.")
Mon code donc ne pouvais exactement convenir
il avait malgré tout des imperfections
Je te propose donc cette version corrigé :

Sheets("T1").Activate
For Each c In Worksheets("T1").Range("A2", Range("IV2").End(xlToLeft))
c.Activate
Application.DisplayAlerts = False
Départ = ActiveCell.Address
Do While ActiveCell.Row < Range("A2").SpecialCells(xlCellTypeLastCell).Row + 1
If ActiveCell Range(Départ, ActiveCell.Address).Merge
End If
If ActiveCell <> ActiveCell.Offset(1, 0) Then
Départ = ActiveCell.Offset(1, 0).Address
End If
ActiveCell.Offset(1, 0).Activate
Loop
Next

Le traitement nécessite que ton tableau débute ligne 2
Le Nom de l'onglet à traiter est "T1"
A actualiser ces lignes si celui-ci devait être modifié :

Sheets("T1").Activate
For Each c In Worksheets("T1").Range("A2", Range("IV2").End(xlToLeft))

Sur ce lien ton document modifié ainsi

http://www.cijoint.fr/cjlink.php?file=cj200809/cija1kHN5r.xls

Active la macro "Fusion"

Donne moi ton avis sur le résultat !!!!!
access13090
Le #16764141
Bonjour FFO,

Difficile pour un "profane" de donner de bonnes explications.
Le travail que tu as réalisé est parfait.
Merci beaucoup.

FFO a écrit :
Rebonjour à toi

J'ai bien analysé ton fichier

Contrairement à ce que tu avais annoncé ton tableau comporte 9 lignes et non
4 et 15 colonnes et non 20 ("Je travaille avec un tableau de 20 colonnes et 4
lignes. la lecture des valeurs est verticale.")
Mon code donc ne pouvais exactement convenir
il avait malgré tout des imperfections
Je te propose donc cette version corrigé :

Sheets("T1").Activate
For Each c In Worksheets("T1").Range("A2", Range("IV2").End(xlToLeft))
c.Activate
Application.DisplayAlerts = False
Départ = ActiveCell.Address
Do While ActiveCell.Row < Range("A2").SpecialCells(xlCellTypeLastCell).Row +
1 If ActiveCell Range(Départ, ActiveCell.Address).Merge
End If
If ActiveCell <> ActiveCell.Offset(1, 0) Then
Départ = ActiveCell.Offset(1, 0).Address
End If
ActiveCell.Offset(1, 0).Activate
Loop
Next

Le traitement nécessite que ton tableau débute ligne 2
Le Nom de l'onglet à traiter est "T1"
A actualiser ces lignes si celui-ci devait être modifié :

Sheets("T1").Activate
For Each c In Worksheets("T1").Range("A2", Range("IV2").End(xlToLeft))

Sur ce lien ton document modifié ainsi

http://www.cijoint.fr/cjlink.php?file=cj200809/cija1kHN5r.xls

Active la macro "Fusion"

Donne moi ton avis sur le résultat !!!!!


Publicité
Poster une réponse
Anonyme