Discussion :

[steph2525]

Bonjour à tous

Je désire concaténer un tableau dont les cellules contiennent uniquement du texte. Chaque colonne a une mise en forme différente (voir tableau ci-joint) : texte en gras, en couleur, souligné et en italique. Mon souci est de préserver la mise en forme de chacune des cellules.

Voici ce que je désire obtenir.

P1 = A1 & B1 & C1 & D1 & E1 & F1 & G1 & H1 & I1 & J1 & K1 & L1 & M1 & N1 & O1 & A2 & B2 & C2 & D2 & E2 & F2 & G2 & H2 & I2 & J2 & K2 & L2 & M2 & N2 & O2 …. & A75 & B75 & C75 & D75 & E75 & F75 & G75 & H75 & I75 & J75 & K75 & L75 & M75 & N75 & O75

Faire la mise forme manuellement d’un tableau ne me poserait pas de souci, juste un peu de temps. Rien de grave ! Mais j’ai en tout un peu plus de 8000 lignes. Là il me faudrait beaucoup de temps et de patience !!!

Je vous remercie tout d’abord de m’avoir lu et d’avance pour les solutions que vous proposerez.

Cordialement Stéphane

[J.Michel]

J'ai écris ce bout de code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
 
Sub MiseEnForme()
    Dim MyCel As Range
    Dim Deb As Long
    ActiveCell.Value = ActiveCell.Address(False, False) & " = "
 
    For Each MyCel In Range("A1", "O75")
        ActiveCell.Value = ActiveCell.Value & MyCel.Address(False, False) & " & "
    Next
 
    With ActiveCell.Font
        .Color = vbBlack
        .Italic = False
        .Bold = False
        .Underline = False
    End With
 
 
    For Each MyCel In Range("A1", "O75")
        Deb = InStr(1, ActiveCell.Value, MyCel.Address(False, False))
 
        With ActiveCell.Characters(Deb, 2).Font
            .Color = MyCel.Font.Color
            .Italic = MyCel.Font.Italic
            .Bold = MyCel.Font.Bold
            .Underline = MyCel.Font.Underline
        End With
    Next
End Sub

Tu te place sur la cellule de destination et tu le lances.
Le seul problème c'est le temps pour que tout se fasse
Tu as le temps d'aller boire un café .......

En fait je pense qu'il doit y avoir plus simple. Déjà je n'ais pas réussi en une seule boucle.
A chaque fois que je fais

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

        ActiveCell.Value = ActiveCell.Value & MyCel.Address(False, False) & " & "

la mise en forme change

Alors si les cracks du VBA Exel peuvent optimiser ce code (ou trouver carrément mieux) on est preneur.

En attendant mieux ca marchotte tout de même

[fring]

Bonjour tlm,

@ JM : je pense que Stéphane veut concaténer le contenu des cellules et que les adresses sont juste comme exemple.

@ Stéphane : tu vas devoir le faire par tronçon pour deux raisons :

1. je n'ai pas les chiffres en tête mais il me semble qu'une cellule peut contenir un nombre maximum de caractères
2. la taille d'une cellule est limitée en hauteur et en largeur, tu ne vas pas pouvoir afficher tout le texte dans une seule cellule

Ci-dessous une autre solution mais je ne sais pas si elle est plus rapide que celle de JM

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Sub MiseEnForme()
Dim Cel As Range, carDeb As Long, carLong As Long, i As Long
Dim Col1 As New Collection, Col2 As New Collection, Col3 As New Collection, Col4 As New Collection, Col5 As New Collection
Application.ScreenUpdating = False
 
For Each Cel In Range("A1:O10")
    Col1.Add Cel
    Col2.Add Cel.Font.ColorIndex
    Col3.Add Cel.Font.Italic
    Col4.Add Cel.Font.Bold
    Col5.Add Cel.Font.Underline
Next
 
For i = 1 To Col1.Count
    ActiveCell = ActiveCell & Col1(i) & " "
Next
 
carDeb = 1
 
For i = 1 To Col1.Count
    carLong = Len(Col1(i))
        With ActiveCell.Characters(carDeb, carLong).Font
            .ColorIndex = Col2(i)
            .Italic = Col3(i)
            .Bold = Col4(i)
            .Underline = Col5(i)
        End With
    carDeb = carDeb + carLong + 1
Next
Application.ScreenUpdating = True
End Sub

[EDIT (pour info)] après vérification, cette procédure est quand même nettement plus rapide : 0,6sec contre 14sec pour la plage A1:O10

[steph2525]

Je suis très impressionné par votre rapidité de réponse.
Mais n'ayant jamais fait de vba, où dois-je mettre ma formule et comment l'exécuter ?

[J.Michel]

[EDIT (pour info)] après vérification, cette procédure est quand même nettement plus rapide : 0,6sec contre 14sec pour la plage A1:O10

C'est l'expérience qui parle ..... Chapeau bas

Je suis très impressionné par votre rapidité de réponse.
Mais n'ayant jamais fait de vba, où dois-je mettre ma formule et comment l'exécuter ?

Il ne s'agit pas d'une formule mais d'une procédure a placer directement dans le code de ta feuille ou du workbook grace à VBA (Alt+F11 quand tu est dans Excel)
Un petit tour dans les tutoriels et FAQ et tu trouveras toutes les infos pour cette petite manip