XL 2016 comparaison de colonnes

[Michest94]

Bonjour,

comment faire des comparaisons de colonnes.
ABCD ( arbo en service) GHIJ ( arbo de base)
entre la colonne A et G ; B et H ; C et I ; D et J

Si différence indiqué par couleur la différence des cellules entre les 2 arbos.
Merci à vous

 

[Staple1600]

Re

Je te laisse tester

Sub ImageARBO2_bis()
Dim tPlg, f As Worksheet: Set f = Sheets("Supervision")
tPlg = Range("F3:I72").Value
    With f.Range("F4").Resize(UBound(tPlg, 1), UBound(tPlg, 2))
        .Value = tPlg: .Font.Bold = -1
    End With
End Sub

 

[Michest94]

Re

Je te laisse tester

Sub ImageARBO2_bis()
Dim tPlg, f As Worksheet: Set f = Sheets("Supervision")
tPlg = Range("F3:I72").Value
    With f.Range("F4").Resize(UBound(tPlg, 1), UBound(tPlg, 2))
        .Value = tPlg: .Font.Bold = -1
    End With
End Sub

OK je vais regardé
Je ne sais pas si tu as eu le fichier explicatif ?

 

[Staple1600]

Re

Si mais je ne peux tout faire.
J'ai une lessive à étendre, moi monsieur.
Faut aussi que je passe l'aspi.

 

[Michest94]

Je viens de tester c'est Nickel et rapide tellement rapide qu'au début j'ai pensé que la macro fonctionnait pas.
Eventuellement si tu le veut, cela peut m'intéresser pour ImageARBO2 qui est aussi issue de mais talent de VBA de l'enregistreur de macro.

Juste un petit détail très minime de présentation concernant la cellule A1 qui est à la base en police 12 ARIAL BLACK et qui passe en 10 ARIAL. C'est curieux car la copie commence en A4.
J'ai regardé le code correspondant j'ai l'impression de voir A4 donc curieux car sur ARBO2 pas de souci sur la cellule I1 elle reste bien en 12 ARIAL BLACK.

 

[Staple1600]

Re

Euh, ce n'est pas moi qui ait écrit le code original.
C'est ton enregistreur de macros

Donc mes versions refont ce qu'il y avait dans ton code original
lol

 

[Michest94]

Re

Euh, ce n'est pas moi qui ait écrit le code original.
C'est ton enregistreur de macros

Donc mes versions refont ce qu'il y avait dans ton code original
lol

Tant pis cela va rester comme ca tes macros sont top, mieux que mon mixage de néophite.(enregistreur de macro)
Je vais ajuster A1 et I1 en ARIAL 10.

 

[Staple1600]

Re

Testes ceci pour voir

Sub mARBO1()
ImageARBO ActiveSheet.Range("D5:G1000"), Sheets("Supervision").Range("A4")
End Sub
Sub mARBO2()
ImageARBO ActiveSheet.Range("F3:I72"), Sheets("Supervision").Range("F4")
End Sub
Private Sub ImageARBO(S_Rng As Range, D_Rng As Range)
Dim tPlg
tPlg = S_Rng.Value: D_Rng.Resize(UBound(tPlg, 1), UBound(tPlg, 2)) = tPlg
End Sub

Comme je le disais le code initial, c'est le tien, non?
Et on pouvait y lire

With Selection.Font
        .Name = "Arial"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
         Range("A4:A1000").Select
    With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
    End With

 

[Michest94]

Re

Testes ceci pour voir

Sub mARBO1()
ImageARBO ActiveSheet.Range("D5:G1000"), Sheets("Supervision").Range("A4")
End Sub
Sub mARBO2()
ImageARBO ActiveSheet.Range("F3:I72"), Sheets("Supervision").Range("F4")
End Sub
Private Sub ImageARBO(S_Rng As Range, D_Rng As Range)
Dim tPlg
tPlg = S_Rng.Value: D_Rng.Resize(UBound(tPlg, 1), UBound(tPlg, 2)) = tPlg
End Sub

Comme je le disais le code initial, c'est le tien, non?
Et on pouvait y lire

With Selection.Font
        .Name = "Arial"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
         Range("A4:A1000").Select
    With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
    End With

C'est nickel Merci.
j'ai vu les lignes en rouge c'est ma soupe faite avec l'enregistreur pourtant ma ligne 1 n'était impliqué dans le coller de ARBO1.
Si tu as d'autres idées d'améliorations je suis preneur...
A ce propos tu ne m'a pas répondu sur le fameux fichier explicatif j'ai pris un peu de temps à l'écrire !
Bon c'est pas grave.

 

[Staple1600]

Re

Je sais que je n'ai pas répondu.
Simplement je fonctionne à mon rythme
Et surtout je suis pas au taf, mais sur un forum peuplé de gens bénévoles.
Et pour ce qui me concerne, le temps est un critère dont je ne tiens absolument pas compte.
(C'est aussi ce dit que la charte du forum, ce me semble )

 

[Michest94]

Re

Je sais que je n'ai pas répondu.
Simplement je fonctionne à mon rythme
Et surtout je suis pas au taf, mais sur un forum peuplé de gens bénévoles.
Et pour ce qui me concerne, le temps est un critère dont je ne tiens absolument pas compte.
(C'est aussi ce dit que la charte du forum, ce me semble )

Y'a pas de soucis Staple1600, au tout début du fil avec toi tu pensais que je répondais pas par rapport à certains post, étant novice sur Excel parfois je m'embrouillais les pinceaux ( quand je reçois de l'infos j'essai de comprendre bon il y a encore du chemin.)
En tout les cas merci

 

[Staple1600]

Alors j'ai été voir ton fichier Explicatif
Puis j'ai fait une syncope

Après m'être réhydraté, je suis retournée illico dans VBE
et j'ai pondu ceci

Sub Hiding_from_the_faces_that_we_know(Optional Watcha = "https://youtu.be/QYafGLTkp94")
Columns("H:T").EntireColumn.Hidden = Not Columns("H:T").EntireColumn.Hidden = True
With ActiveWindow
    .DisplayHeadings = Not .DisplayHeadings
    .ScrollColumn = 1: .ScrollRow = 1
End With
End Sub

PS: Je te laisse trouver quelle(s) macro(s) à toi mon code remplace
Et il fait la même chose.
Et si tu regardes bien, il y a un cadeau B.nux dedans

NB: Pour gouter à la substantifique moelle de cette macro, il faut l'exécuter deux fois de suite.

 

[Michest94]

Alors j'ai été voir ton fichier Explicatif
Puis j'ai fait une syncope

Après m'être réhydraté, je suis retournée illico dans VBE
et j'ai pondu ceci

Sub Hiding_from_the_faces_that_we_know(Optional Watcha = "https://youtu.be/QYafGLTkp94")
Columns("H:T").EntireColumn.Hidden = Not Columns("H:T").EntireColumn.Hidden = True
With ActiveWindow
    .DisplayHeadings = Not .DisplayHeadings
    .ScrollColumn = 1: .ScrollRow = 1
End With
End Sub

PS: Je te laisse trouver quelle(s) macro(s) à toi mon code remplace
Et il fait la même chose.
Et si tu regardes bien, il y a un cadeau B.nux dedans

NB: Pour gouter à la substantifique moelle de cette macro, il faut l'exécuter deux fois de suite.

Bon j'ai vu que cela concerne le masquage et démasquage, encore une de mes compositions.
Pour faire fonctionner ta merveille c'est une autre histoire mais bon je vais chercher ...
J'ai quand même vu le cadeau c'est sympa avant noël. (musique sympa)

 

[Staple1600]

Re

Je ne fais que suivre ton vœu, jeune padawan

C'est nickel Merci.
Si tu as d'autres idées d'améliorations je suis preneur...

Ma macro remplace ces deux macros

Sub masquer()
Columns("H:T").Select
Selection.EntireColumn.Hidden = True
ActiveWindow.DisplayHeadings = False
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = 1
'Range("A5").Select
End Sub

Sub demasquer()
Columns("H:T").Select
Selection.EntireColumn.Hidden = False
ActiveWindow.DisplayHeadings = True
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = 1
'Range("A5").Select
End Sub

 

[Michest94]

Je te remercie Maitre Yoda.
Tout est bon pour moi, un petit peu titiller parfois ... mais bon !

"L'imagination est plus importante que le savoir." A. Einstein