Fonction concatener mise en forme (bis)

[lauren]

Rebonsoir!

Voici mon petit fichier!
Je pourrais ensuite faire un vulgaire copier-coller (ou collage spécial-valeur) de votre résultat de VBA?

En tout cas, merci vraiment merci mille fois de votre aide!

Lauren

 

[jeanpierre]

Re : Fonction concatener mise en forme (bis)

Re coucou lauren,

On t'attend ici : https://www.excel-downloads.com/threads/fonction-concatener-mise-en-forme.114670/

Sinon personne ne va rien comprendre.

Il faut rester sur le même fil tant que la question est la même. Merci d'en tenir compte à l'avenir.

Bonne nuit cette fois, j'y vais.

Jean-Pierre

 

[soenda]

Re : Fonction concatener mise en forme (bis)

Bonsoir à tous jeanpierre, Lauren

Voici mon petit fichier!
Je pourrais ensuite faire un copier-coller ... de votre résultat en VBA

Que dois faire le résultat ... en VBA

A plus

 

[alexga78]

Re : Fonction concatener mise en forme (bis)

Bonsoir Lauren, jean-pierre,le forum
un essai par macro
bonne nuit à tous

edition : ajout gras pour début du texte
bonsoir Excel-lent, pas de souci de toute facon ta macro est bien plus aboutie que la mienne...je dois encore persévérer

 

[Excel-lent]

Re : Fonction concatener mise en forme (bis)

Bonsoir Lauren, JeanPierre, Soenda, le fil,


Tu trouveras ci-joint ton fichier ainsi que la macro.

Pour lancer la macro, il te suffit de cliquer sur "Alt" + "F8"
Dans la liste présente dans la fenêtre qui vient de s'ouvrir, choisir : "Feuil1.ConcaténerEtMiseEnForme"

Après, selon tes besoins, tu pourras :
-> rajouter un bouton sur ta feuille : ainsi chaque fois que tu cliqueras dessus, la macro se lancera (concaténation + mise en forme)

-> modifier le code pour qu'il se lance automatiquement :
* à chaque ouverture du fichier
* à chaque fermeture du fichier
* à chaque modification dans la feuille (étant donnée la taille de ta base de donnée, je te le déconseille, se sera vite casse-pied! Pour traiter 700 lignes, la macro tourne durant 2,5 secondes, donc si tu as 65536 lignes (maxi dans Excel 2003), je te laisse calculer!)
* lors d'une saisie particulière dans une cellule convenu à l'avance
* ...

Remarques :
-> la macro s'adapte automatiquement à la taille de ta base de donnée
-> si tu veux recopier la macro de ce fichier sur ton fichier, il te suffit :
* d'aller dans l'éditeur de macro ("Alt" + "F11")
* de copier coller la macro Sub ConcaténerEtMiseEnForme() dans ton fichier
* puis mise en place d'un bouton pour lancer la macro ou ... (cf. ci-dessus)
-> lors du recopiage de la mise en forme, la macro tient compte :
* la taille de la police
* la couleur de la police
* gras / non gras
* italique / non italique
* souligné / non souligné (+ type de soulignement : simple / double / ...)
-> et c'est tout! Je crois n'avoir rien oublié.
-> je n'ai pas traité la couleur de fond de la cellule car je ne pense pas que cela soit possible

Bon WE à toi.

Edition : Bonsoir Alexga78, pas vu

 

[jeanpierre]

Re : Fonction concatener mise en forme (bis)

Re lauren, Bonsoir soenda, alexga78, Excel-lent,

Moralité, pour avoir une bonne réponse, et il semble que tu saches parler aux hommes, il suffit d'imiter le cri de la bouteille légèrement penchée, en italique, et en direction du verre... que du bonheur dans les réponses.

Sur ce maintenant bonne nuit.

Jean-Pierre

 

[soenda]

Re : Fonction concatener mise en forme (bis)

Bonjour lauren, alexga78, Excel-lent, jeanpierre

@Excel-lent

Pour traiter 700 lignes, la macro tourne durant 2,5 secondes

Avec

Application.ScreenUpdating = false
...ton code
Application.ScreenUpdating = true

tu devrais pouvoir "gratter" une seconde

A plus

 

[lauren]

Re : Fonction concatener mise en forme (bis)

Merci merci merci merci à Soenda, Alexga78, Jeanpierre et Excel-lent !
Vous êtes tous tellement sympas, je ne sais pas quoi dire!
Merci Excel-lent d'avoir pris autant de temps pour ta réponse, tu es très pédagogue!!
Vraiment merci!
Bonne journée à tous et à toutes!
Peut-être à tout à l'heure sur le forum, j'ai malheureusement encore pleins de questions

Encore Merci!!!

Lauren

 

[Excel-lent]

Re : Fonction concatener mise en forme (bis)

Bonjour Soenda,

Application.ScreenUpdating = false
...ton code
Application.ScreenUpdating = true

tu devrais pouvoir "gratter" une seconde

Je connaissais cette astuce et son pouvoir magique : rendre l'exécution de la macro invisible pour l'utilisateur, mais pas celui de faire gagner du temps!
Astuce initialement non utilisé, pour éviter de compliquer encore plus le code, car Lauren est débutant en VBA. Mais vu les avantages que cette astuce apporte, je vais quand même le rajouter!

Code testé, j'ai gratté : 0.5 seconde

Merci à toi.

Lauren,

Voici ci-dessous comment modifier la macro pour tenir compte de la remarque de Soenda. Rajouter la ligne bleu à l'endroit indiqué

Sub ConcaténerEtMiseEnForme()
' Macro réalisé par Excel-lent

Dim Ligne As Long

[COLOR="Blue"]Application.ScreenUpdating = False[/COLOR]
For Ligne = 1 To [A65536].End(xlUp).Row
    ' Effacement de la colonne C
    Range("C" & Ligne).Clear
[COLOR="Red"][I]... suite de la macro[/I][/COLOR]

[COLOR="Red"][I]... début de la macro[/I][/COLOR]
    ' Recopie : souligné / non souligné (+ type de soulignement : simple / double / ...)
     Range("C" & Ligne).Characters(Start:=1, Length:=Len(Range("A" & Ligne))).Font.Underline = Range("A" & Ligne).Font.Underline
     Range("C" & Ligne).Characters(Start:=Len(Range("A" & Ligne)) + 2, Length:=Len(Range("B" & Ligne))).Font.Underline = Range("B" & Ligne).Font.Underline

Next Ligne
[COLOR="Blue"]Application.ScreenUpdating = True[/COLOR]

End Sub

tu es très pédagogue!!

C'était ça ou les fautes d'orthographe+grammaire! J'ai préféré retenir la première solution

Dans la macro, toutes les lignes commençant par '
c'est juste pour t'expliquer ce que fais la macro. Si tu efface ces lignes, la macro fonctionnera très bien aussi.
J'ai essayé de lancer la macro "avec commentaires" et "sans commentaire", le temps d'éxécution est le même, donc tu fais comme tu veux.

Bon samedi à tous

 

[soenda]

Re : Fonction concatener mise en forme (bis)

Bonjour le fil, lauren, alexga78, Excel-lent, jeanpierre

Code testé, j'ai gratté : 0.5 seconde

Avec la petite optimisation en PJ, tu devrais pouvoir gratter 1 seconde de plus

A plus

Edit: Mais il y a certainement beaucoup mieux...

 

[vbacrumble]

Re : Fonction concatener mise en forme (bis)

Bonjour à tous


Pour gagner encore un tout petit peu

Modifier comme suit (ajout des lignes en bleu et mise en commentaire ligne verte )

Derligne = [A65536].End(xlUp).Row'*
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'For Ligne = 1 To [A65536].End(xlUp).Row
For Ligne = 1 To Derligne

et à fin du code ne pas oublier de remettre

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

A+

PS: * tribute à PascalXLD

 

[Excel-lent]

Re : Fonction concatener mise en forme (bis)

Bonsoir tout le monde,

Avec la petite optimisation en PJ, tu devrais pouvoir gratter 1 seconde de plus

En effet, ta macro es beaucoup plus rapide que la mienne

Mais le résultat retourné par ta macro est légèrement faux (pb au niveau de Len ? Je t'avouerais que j'ai pas cherché!)

Vbacrumble, merci pour ta participation, grâce à toi, nous avons gagné encore 0.20 seconde de mieux

Lauren,

Dans tout ce jargon, tu dois t'y perdre un peu! Voici donc ci-dessous ma macro (basique : sans commentaire) modifié avec l'aide de tous les participants du fil (annule et remplace ma précédente macro) :

La macro tournait à l'origine en 1"90, maintenant elle tourne en 1"42
Evidement, même si la macro y est pour beaucoup, le temps d'exécution dépend également de la puissance de ton PC

Sub ConcaténerEtMiseEnForme()
' Macro réalisé par Excel-lent avec la participation de Soenda et Vbacrumble

Dim Ligne As Long
Dim Derligne As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Derligne = [A65536].End(xlUp).Row
[COLOR="Blue"]Columns("C:C").Clear[/COLOR]

For Ligne = 1 To Derligne
     Range("C" & Ligne) = Range("A" & Ligne) & " " & Range("B" & Ligne)
     Range("C" & Ligne).Characters(Start:=1, Length:=Len(Range("A" & Ligne))).Font.ColorIndex = Range("A" & Ligne).Font.ColorIndex
     Range("C" & Ligne).Characters(Start:=Len(Range("A" & Ligne)) + 2, Length:=Len(Range("B" & Ligne))).Font.ColorIndex = Range("B" & Ligne).Font.ColorIndex
     Range("C" & Ligne).Characters(Start:=1, Length:=Len(Range("A" & Ligne))).Font.Size = Range("A" & Ligne).Font.Size
     Range("C" & Ligne).Characters(Start:=Len(Range("A" & Ligne)) + 2, Length:=Len(Range("B" & Ligne))).Font.Size = Range("B" & Ligne).Font.Size
     Range("C" & Ligne).Characters(Start:=1, Length:=Len(Range("A" & Ligne))).Font.Bold = Range("A" & Ligne).Font.Bold
     Range("C" & Ligne).Characters(Start:=Len(Range("A" & Ligne)) + 2, Length:=Len(Range("B" & Ligne))).Font.Bold = Range("B" & Ligne).Font.Bold
     Range("C" & Ligne).Characters(Start:=1, Length:=Len(Range("A" & Ligne))).Font.Italic = Range("A" & Ligne).Font.Italic
     Range("C" & Ligne).Characters(Start:=Len(Range("A" & Ligne)) + 2, Length:=Len(Range("B" & Ligne))).Font.Italic = Range("B" & Ligne).Font.Italic
double / ...)
     Range("C" & Ligne).Characters(Start:=1, Length:=Len(Range("A" & Ligne))).Font.Underline = Range("A" & Ligne).Font.Underline
     Range("C" & Ligne).Characters(Start:=Len(Range("A" & Ligne)) + 2, Length:=Len(Range("B" & Ligne))).Font.Underline = Range("B" & Ligne).Font.Underline

Next Ligne

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

Vous noterez que j'ai remplacé :

    Range("C" & Ligne).Clear

par :

    [COLOR="Blue"]Columns("C:C").Clear[/COLOR]

Car comme souligné, en effet, il est inutile d'effacer la cellule [C...], car elle sera écrasé. Mais si au lieu de s'agrandir, le tableau venait à se réduire!?!?Ben oui!!! De si bonnes bouteilles, c'est fait pour être bu
D'où ma modification.

Merci à tous les participants, sans qui cela n'aurait pu être possible

Edition : comme très justement soulevé dans le post de Soenda de 18h21, Columns("C:C").Clear était mis au mauvaise endroit! Erreur réparé ci-dessus.

 

[soenda]

Re : Fonction concatener mise en forme (bis)

Re, le fil, lauren, alexga78, Excel-lent, jeanpierre

Bonjour vbacrumble

J'ai testé tes optimisations et je suis assez surpris du résultat

Derligne = [A65536].End(xlUp).Row
For Ligne = 1 To Derligne

à la place de

For Ligne = 1 To [A65536].End(xlUp).Row

Fait perdre quelques centièmes de seconde (testé sur les Sub du fil)


Par contre, et là aussi je suis surpris

Application.Calculation = xlCalculationManual
...
Application.Calculation = xlCalculationAutomatic

Fait bien gagner quelques centièmes de seconde sur les 2 Sub
(jusqu'à 7 centièmes sur la 1ère Sub et 2 à 3 centièmes sur 2ème Sub)

A plus

 

[Excel-lent]

Re : Fonction concatener mise en forme (bis)

RE,

Par contre, et là aussi je suis surpris

Application.Calculation = xlCalculationManual
...
Application.Calculation = xlCalculationAutomatic

Fait bien gagner quelques centièmes de seconde

Non, cela me semble cohérent! Etant donnée que la macro rempli les cellules une par une et qu'en mode normal (calcul automatique), l'ordinateur recalcul tout le fichier à chaque modification.

Le fait de désactiver le "calcul automatique" au début, et le remettre à la fin, permet de faire faire le calcul une seul fois (à la fin) au lieu de le faire autant de fois qu'il y a de cellules modifiées (soit 694 dans l'exemple qui nous occupe).

Ici, le temps gagné est très minime, car la complexité des calculs est quasi null, mais s'il y avait plus de 500 cellules rempli de SOMMEPROD() ou formules matricielles...

Sympa ce fil! J'y apprend plein de truc

 

[vbacrumble]

Re : Fonction concatener mise en forme (bis)

Re à tous

EDITION: soenda , j'ai fait cette modif suite à ce conseil de PAscalXLD
Lien supprimé
Tu me confirmer ou infirmer ?


J'essaie en vain depuis tout à l'heure de faire un truc du genre (en vain)

tablo1=Array("1, nCarA","nCarA + 2, nCarB")
tablo2=Array("ColA",ColB")
For i=0 to UBound(tablo1)
With .Characters(tablo1(i), tablo1(i)).Font
       .Bold = Range(cstr(tablo2(i))).Font.Bold
       .Italic = Range(cstr(tablo2(i))).Font.Italic
       .Underline = Range(cstr(tablo2(i))).Font.Underline
       End With
next i

à la place de

With .Characters(1, nCarA).Font
              .Bold = Range(ColA).Font.Bold
              .Italic = Range(ColA).Font.Italic
              .Underline = Range(ColA).Font.Underline
         End With

         With .Characters(nCarA + 2, nCarB).Font
                .Bold = Range(ColB).Font.Bold
                .Italic = Range(ColB).Font.Italic
                .Underline = Range(ColB).Font.Underline
        End With

C'est possible ou pas ?

A+