Fusionner des cellules en fonction d'un résultat

  • Initiateur de la discussion Initiateur de la discussion vanesa
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

vanesa

XLDnaute Nouveau
Bonjour à tous

Est-il possible de fusionner automatiquement deux cellules en fonction d'un résultat ?! (soit grâce à une macro ou soit grâce à une fonction conditionnelle)

Exemple:
Si A1 = "accepter" alors B1, C1, D1, E1 et B2, C2, D2 et E2 se fusionnent en supprimant les informations contenus dans chacune de ces cellules (en effet, B1, C1, D1, E1 et B2, C2, D2 et E2 contiennent déjà des valeurs)

Merci et bonne journée
 
Dernière édition:
Re : Fusionner des cellules en fonction d'un résultat

Re,

elle est où la macro qui te pose problème ?? si c'est dans le module1, c'est normal, une procédure événementielle (Worksheet_Change) est faite pour fonctionner uniquement dans son module....
 
Re : Fusionner des cellules en fonction d'un résultat

Re,

pas de (tableau compte rendu 1-1).... ton fichier toujours en lecture seule, je ne peux travailler desus de toute façon... quand tu mets un fichier sur le forum, mets uniquement la mactro qui pose problème....
 
Re : Fusionner des cellules en fonction d'un résultat

exemple de macro qui pose problème
sinon il faut enregistrer le fichier pour que la lecture seule se désactive

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$B$26" Then
With Range("D26").Validation
If Target.Value = "Commande" Then
.Delete
.Add Type:=xlValidateList, Formula1:="=$B$26:$B$45"
Else
.Delete
End If
End With
End If

If Target.Address <> "$B$28" Then Exit Sub
With Range("D28").Validation
If Target.Value = "Commande" Then
.Delete
.Add Type:=xlValidateList, Formula1:="=$B$28:$B$45"
Else
.Delete
End If
End With

End Sub
 
Re : Fusionner des cellules en fonction d'un résultat

une macro qui ne fonctionne pas

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$E$26" Then
With Range("F27:J27")
.Value = ""
If Target.Value = "Autre et observation :" Then
.Merge
Else
.UnMerge
End If
End With
End If

If Target.Address = "$E$28" Then
With Range("F29:J29")
.Value = ""
If Target.Value = "Autre et observation :" Then
.Merge
Else
.UnMerge
End If
End With
End If

If Target.Address = "$E$30" Then
With Range("F31:J31")
.Value = ""
If Target.Value = "Autre et observation :" Then
.Merge
Else
.UnMerge
End If
End With
End If

If Target.Address = "$E$32" Then
With Range("F33:J33")
.Value = ""
If Target.Value = "Autre et observation :" Then
.Merge
Else
.UnMerge
End If
End With
End If

If Target.Address = "$E$34" Then
With Range("F35:J35")
.Value = ""
If Target.Value = "Autre et observation :" Then
.Merge
Else
.UnMerge
End If
End With
End If

If Target.Address = "$E$36" Then
With Range("F37:J37")
.Value = ""
If Target.Value = "Autre et observation :" Then
.Merge
Else
.UnMerge
End If
End With
End If

If Target.Address = "$E$38" Then
With Range("F39:J39")
.Value = ""
If Target.Value = "Autre et observation :" Then
.Merge
Else
.UnMerge
End If
End With
End If

If Target.Address = "$E$40" Then
With Range("F41:J41")
.Value = ""
If Target.Value = "Autre et observation :" Then
.Merge
Else
.UnMerge
End If
End With
End If

If Target.Address = "$E$42" Then
With Range("F43:J43")
.Value = ""
If Target.Value = "Autre et observation :" Then
.Merge
Else
.UnMerge
End If
End With
End If

If Target.Address <> "$E$44" Then
With Range("F45:J45")
.Value = ""
If Target.Value = "Autre et observation :" Then
.Merge
Else
.UnMerge
End If
End With
End If
(je rajoute une macro différente et plus rien ne fonctionne)
If Target.Address <> "$B$32" Then
With Range("D32").Validation
If Target.Value = "Pas de commande" Then
.Delete
.Add Type:=xlValidateList, Formula1:="=$B$26:$B$45"
Else
.Delete
End If
End With
End If

If Target.Address <> "$B$34" Then Exit Sub
With Range("D34").Validation
If Target.Value = "Pas de commande" Then
.Delete
.Add Type:=xlValidateList, Formula1:="=$B$26:$B$45"
Else
.Delete
End If
End With
End Sub
 
Re : Fusionner des cellules en fonction d'un résultat

une macro qui fonctionne

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$E$26" Then
With Range("F27:J27")
.Value = ""
If Target.Value = "Autre et observation :" Then
.Merge
Else
.UnMerge
End If
End With
End If

If Target.Address = "$E$28" Then
With Range("F29:J29")
.Value = ""
If Target.Value = "Autre et observation :" Then
.Merge
Else
.UnMerge
End If
End With
End If

If Target.Address = "$E$30" Then
With Range("F31:J31")
.Value = ""
If Target.Value = "Autre et observation :" Then
.Merge
Else
.UnMerge
End If
End With
End If

If Target.Address = "$E$32" Then
With Range("F33:J33")
.Value = ""
If Target.Value = "Autre et observation :" Then
.Merge
Else
.UnMerge
End If
End With
End If

If Target.Address = "$E$34" Then
With Range("F35:J35")
.Value = ""
If Target.Value = "Autre et observation :" Then
.Merge
Else
.UnMerge
End If
End With
End If

If Target.Address = "$E$36" Then
With Range("F37:J37")
.Value = ""
If Target.Value = "Autre et observation :" Then
.Merge
Else
.UnMerge
End If
End With
End If

If Target.Address = "$E$38" Then
With Range("F39:J39")
.Value = ""
If Target.Value = "Autre et observation :" Then
.Merge
Else
.UnMerge
End If
End With
End If

If Target.Address = "$E$40" Then
With Range("F41:J41")
.Value = ""
If Target.Value = "Autre et observation :" Then
.Merge
Else
.UnMerge
End If
End With
End If

If Target.Address = "$E$42" Then
With Range("F43:J43")
.Value = ""
If Target.Value = "Autre et observation :" Then
.Merge
Else
.UnMerge
End If
End With
End If

If Target.Address <> "$E$44" Then Exit Sub
With Range("F45:J45")
.Value = ""
If Target.Value = "Autre et observation :" Then
.Merge
Else
.UnMerge
End If
End With

End Sub
 
Re : Fusionner des cellules en fonction d'un résultat

Re,

et c'est quoi ca ne fonctionne pas ?... message d'erreur ou pas le résultat attendu ?
essaye comme ceci, interrompera momentanément les procédures événementielles..
Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
'ton code
Application.EnableEvents = True
End Sub
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
10
Affichages
204
Réponses
1
Affichages
637
Retour