Coller 2 colonnes sans fusion

[eSb`]

Bonjour à tous,

J'aimerais réaliser une sorte de "Format Personnalisé" impliquant 2 couleurs différentes.
L'idée est d'avoir des cases avec un préfixe commun à plusieurs cellules et d'éditer le suffixe.

Je voudrais donc avoir par exemple F100 où l'utilisateur ne rentre que 00 et le F1 s'ajoute seul avec la mise en forme voulue.

Je ne pense pas qu'on puisse utiliser 2 couleurs dans un format personnalisé et ai donc voulu faire au plus simple en ayant une colonne dans laquelle j'insère F1 et une seconde avec le suffixe à mettre.
J'ai aligné à droite pour la première et à gauche pour la seconde en espérant une mise en page parfaite mais ce n'est pas le cas; un espace apparaît.

Ma question est donc la suivante :
- Le but est d'éditer le préfixe F1 sans impacter les suffixes et sans que j'aie à tout mettre à jour à la main.
- Comment puis-je avoir un système facile à éditer en évitant les macros et colonnes vides tampon pour obtenir un préfixe et un suffixe avec deux mises en forme différents ?

Merci d'avance.

 

[Hippolite]

Re : Coller 2 colonnes sans fusion

Bonsoir eSb,
Si tu changes d'avis, il y a une ébauche de macro ici :
excel-downloads.com/forum/163139-conditionnement-ou-formule-2-couleurs-1-cellule
A+

 

[eSb`]

Re : Coller 2 colonnes sans fusion

Merci pour la réponse. En fait, j'aurais vraiment aimé un truc simpliste sans "post-traitement".
C'est impossible de coller 2 colonnes dans Excel sans espace entre ces colonnes ?

 

[Hippolite]

Re : Coller 2 colonnes sans fusion

Re,
A ma connaissance, ce n'est pas possible.
Mais si ce qui te gêne est bien le post traitement et pas le fait d'avoir une macro, utilise les macro événémentielles. Par exemple, le code ci dessous concatène automatiquement en colonne C les colonnes A et B avec leurs formats de caractères, quand une valeur est changée dans une de ces deux colonnes

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        Concat Cel_12:=Target.Offset(, 2), Cel1:=Target, Cel2:=Target.Offset(, 1)
    End If
    
    If Not Intersect(Target, Range("B:B")) Is Nothing Then
        Concat Cel_12:=Target.Offset(, 1), Cel1:=Target.Offset(, -1), Cel2:=Target
    End If

End Sub

Sub Concat(Cel_12 As Range, Cel1 As Range, Cel2 As Range)
    Cel_12.NumberFormat = "@"
    Cel_12 = Cel1.Text & Cel2.Text
    With Cel_12.Characters(Start:=1, Length:=Len(Cel1.Text)).Font
        .Name = Cel1.Font.Name
        .FontStyle = Cel1.Font.FontStyle
        .Size = Cel1.Font.Size
        .Strikethrough = Cel1.Font.Strikethrough
        .Superscript = Cel1.Font.Superscript
        .Subscript = Cel1.Font.Subscript
        .OutlineFont = Cel1.Font.OutlineFont
        .Shadow = Cel1.Font.Shadow
        .Underline = Cel1.Font.Underline
        .ColorIndex = Cel1.Font.ColorIndex
    End With
    With Cel_12.Characters(Start:=Len(Cel1.Text) + 1, _
            Length:=Len(Cel2.Text)).Font
        .Name = Cel2.Font.Name
        .FontStyle = Cel2.Font.FontStyle
        .Size = Cel2.Font.Size
        .Strikethrough = Cel2.Font.Strikethrough
        .Superscript = Cel2.Font.Superscript
        .Subscript = Cel2.Font.Subscript
        .OutlineFont = Cel2.Font.OutlineFont
        .Shadow = Cel2.Font.Shadow
        .Underline = Cel2.Font.Underline
        .ColorIndex = Cel2.Font.ColorIndex
    End With
End Sub

A+

 

[eSb`]

Re : Coller 2 colonnes sans fusion

Merci.
L'idée est bien là, je vais voir ce que je peux en faire.

En fait, l'idéal est d'avoir un préfixe commun à un groupe de cellules de taille variable. Donc par exemple le préfixe F1 qui sera commun à F101, F102, ... F10N
Ce préfixe apparaît dans une case et je voudrais que l'utilisateur n'entre que le suffixe (donc 01, 02, ...). L'idéal serait qu'il rentre ces données et que le préfixe s'ajoute dessus "tout seul". C'est pourquoi un format personnalisé aurait été intéressant.

Ca doit être faisable avec la technique donnée ici et une colonne "cachée", il faut que j'essaie mais ça me paraît plus compliqué que voulu au départ ; ).

 

[Hippolite]

Re : Coller 2 colonnes sans fusion

Re,
Si j'ai bien comprisle besoin :
entrer une valeur en F101:F199, avec (à adapter en mettant les paramètres sur une autre feuille)
en F100 le préfixe mis en forme,
en G100 la mise en forme du suffixe,
et en gardant la macro de concaténation Sub Concat :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Temp As Range
    If Not Intersect(Target, Range("F101:F199")) Is Nothing And Target.Count = 1 Then
        Application.EnableEvents = False
        Set Temp = Target
        Range("G100").Copy
        Target.PasteSpecial xlPasteFormats
        Concat Cel_12:=Target, Cel1:=Range("F100"), Cel2:=Temp 
        Application.EnableEvents = True
    End If
End Sub

A+

 

[eSb`]

Re : Coller 2 colonnes sans fusion

Merci,

On s'en rapproche mais ce n'est pas encore tout à fait ça. Je n'ai pas pu plus détailler tout à l'heure par faute de temps.
J'ai joint ce que je voudrais de manière plus précise.

Le dernier code envoyé correspond bien à la demande mais ce que je voudrais est d'avoir quelques chose de plus modulaire (d'où mon envie initiale d'éviter les macros).

En pièce jointe, je montre un résultat désiré. On a un préfixe (ici F1 à F4 mais indépendant du numéro de cellule ; )) et de là, on retrouve "un certain nombre de suffixes"; ce nombre est inconnu au départ et on doit pouvoir ajouter autant de suffixes que voulu sans problèmes.

La position des cellules F1, F2, F3 et F4 n'est pas figée au départ (enfin, en y repensant, on pourrait l'envisager).

Enfin bref, je devrais pouvoir me débrouiller avec les codes déjà donnés.

 

[Hippolite]

Re : Coller 2 colonnes sans fusion

Re,
Avec des références de format en D1 et D2
Agit sur B1:C12

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("B1:C12")) Is Nothing And Target.Count = 1 Then
		If Target.Offset(,-1) = "" Then
			Application.EnableEvents = False
			Set Ref1 = Range("D1")
			Set Ref2 = Range("D2")
			'On peut ausi supprimer les deux celules de référence des formats et les graver en dur
			Target.NumberFormat = "@"
			Target = Target.offset(,-1).End(xlUp).Text & Target.Text
			With Target.Characters(Start:=1, Length:=2).Font
				.Name = Ref1.Font.Name
				.FontStyle = Ref1.Font.FontStyle
				.Size = Ref1.Font.Size
				.Strikethrough = Ref1.Font.Strikethrough
				.Superscript = Ref1.Font.Superscript
				.Subscript = Ref1.Font.Subscript
				.OutlineFont = Ref1.Font.OutlineFont
				.Shadow = Ref1.Font.Shadow
				.Underline = Ref1.Font.Underline
				.ColorIndex = Ref1.Font.ColorIndex
    		End With
    		With Target.Characters(Start:=3, Length:=Len(Target.Text)-2).Font
				.Name = Ref2.Font.Name
				.FontStyle = Ref2.Font.FontStyle
				.Size = Ref2.Font.Size
				.Strikethrough = Ref2.Font.Strikethrough
				.Superscript = Ref2.Font.Superscript
				.Subscript = Ref2.Font.Subscript
				.OutlineFont = Ref2.Font.OutlineFont
				.Shadow = Ref2.Font.Shadow
				.Underline = Ref2.Font.Underline
				.ColorIndex = Ref2.Font.ColorIndex
    		End With
			Application.EnableEvents = True
		Else
			Target = ""
		End If
    End If
End Sub

A+