[Déplacé VBA - VBS]Surligner une cellule si une cellule B = 1Résolu

Question

Bonjour,

Alors sur une page j'ai un tableau A et un tableau B

Le tableau B contient des cellules avec des 1 dedans.

Je voudrais que quand dans le tableau B il y a un 1 dans une cellule par exemple S4, ça me surligne des cellules du tableau A.

J'ai fait ceci (quand S4=1, A13 et A14 sont surligné en jaune):

Sub test_surlignage()

If Range("S4").Value "1" Then Range("A13:A14").Interior.Color vbYellow
If Range("S5").Value "1" Then Range("A15:A16").Interior.Color vbYellow
If Range("S6").Value "1" Then Range("A17:A18").Interior.Color vbYellow
If Range("S7").Value "1" Then Range("A19:A20").Interior.Color vbYellow
If Range("S8").Value "1" Then Range("A21:A22").Interior.Color vbYellow
If Range("S9").Value "1" Then Range("A23:A24").Interior.Color vbYellow
If Range("S10").Value "1" Then Range("A25:A26").Interior.Color vbYellow
If Range("S11").Value "1" Then Range("A27:A28").Interior.Color vbYellow
If Range("S12").Value "1" Then Range("A29:A30").Interior.Color vbYellow
If Range("S13").Value "1" Then Range("A31:A32").Interior.Color vbYellow
If Range("S14").Value "1" Then Range("A33:A34").Interior.Color vbYellow
If Range("S15").Value "1" Then Range("A35:A36").Interior.Color vbYellow

End Sub

ça fonctionne bien, mais le probleme c'est que je dois arriver a faire ça jusqu'a la cellule A1562 pour le tableau A et jusqu'a AV sur le tableau B
Et la colonne S du tableau A correspond aux cellules A13 a A36, la colonne T aux cellules A67 a A90.

Du coup j'ai continuer avec ça mais c'est un peu long a tout faire, donc je voulais savoir si yaurait pas une solution pour faire ça beaucoup plus vite !

Merci.

If Range("T4").Value "1" Then Range("A67:A68").Interior.Color vbYellow
If Range("T5").Value "1" Then Range("A69:A70").Interior.Color vbYellow
If Range("T6").Value "1" Then Range("A71:A72").Interior.Color vbYellow
If Range("T7").Value "1" Then Range("A73:A74").Interior.Color vbYellow
If Range("T8").Value "1" Then Range("A75:A76").Interior.Color vbYellow
If Range("T9").Value "1" Then Range("A77:A78").Interior.Color vbYellow
If Range("T10").Value "1" Then Range("A79:A80").Interior.Color vbYellow
If Range("T11").Value "1" Then Range("A81:A82").Interior.Color vbYellow
If Range("T12").Value "1" Then Range("A83:A84").Interior.Color vbYellow
If Range("T13").Value "1" Then Range("A85:A86").Interior.Color vbYellow
If Range("T14").Value "1" Then Range("A87:A88").Interior.Color vbYellow
If Range("T15").Value "1" Then Range("A89:A90").Interior.Color vbYellow

If Range("U4").Value "1" Then Range("A121:A122").Interior.Color vbYellow
If Range("U5").Value "1" Then Range("A123:A124").Interior.Color vbYellow
If Range("U6").Value "1" Then Range("A125:A126").Interior.Color vbYellow
If Range("U7").Value "1" Then Range("A127:A128").Interior.Color vbYellow
If Range("U8").Value "1" Then Range("A129:A130").Interior.Color vbYellow
If Range("U9").Value "1" Then Range("A131:A132").Interior.Color vbYellow
If Range("U10").Value "1" Then Range("A133:A134").Interior.Color vbYellow
If Range("U11").Value "1" Then Range("A135:A136").Interior.Color vbYellow
If Range("U12").Value "1" Then Range("A137:A138").Interior.Color vbYellow
If Range("U13").Value "1" Then Range("A139:A140").Interior.Color vbYellow
If Range("U14").Value "1" Then Range("A141:A142").Interior.Color vbYellow
If Range("U15").Value "1" Then Range("A143:A144").Interior.Color vbYellow

cs_GG72 · Accepted Answer

Je me suis inspiré du code de ucfoutu en le modifiant.
Ca a l'air de fonctionner comme ceci:

For colonne = Columns("S").Column To Columns("U").Column
    For i = 0 To 11
      If Cells(i + 4, colonne).Value = 1 Then
        toto = (colonne - 18) * 54 - 41 + i * 2
        Range("A" & toto & ":A" & toto + 1).Interior.Color = vbYellow
      End If
    Next
  Next

Cordialement.

ucfoutu · Answer

Bonjour,

Tu ne développe pas sous VBScript, mais sous VBA ( le VBA de Excel). Prends dorénavant le plus grand soin, s'il te plait, à "poster" dans la section adéquate.

- j'ai pour principe intime de ne pas toujours tout faire, mais de mettre sur des rails et laisser l'autre continuer sur la lancée.

Regarde ce que ferait ceci :
For colonne = Columns("S").Column To Columns("U").Column
  For i = 4 To 15
    If Cells(i, colonne).Value = 1 Then
      toto = (i + 9) + i Mod 4
      Range("A" & toto & ":A" & toto + 1).Interior.Color = vbYellow
    End If
  Next
Next

Impeccable, hein, pour la colonne "S" (la première). Ce n'est que de l'arithmétique.
Que faut-il ajouter à ces petits calculs pour que soient, dans la même foulée, également traitées convenablement les colonne T et U ? ===>> presque rien  pour peu que tu y réfléchisse bien.

____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

cs_GG72 · Answer

Bonjour, 

Tu sembles être en VBA Excel plutôt que VBScript.

Tu peux donner un nom à ton tableau B.
Y parcourir toutes les cellules avec l'instruction For Each pour tester si égale = 1.
En fonction de l'adresse de la cellule, calculer, par une fonction, l'adresse du Range à colorier.

ucfoutu · Answer

Ouais
je t"'ai "vu" ici, mais muet ...
Allons bon !
regarde comme c'était simple :
 For colonne = Columns("S").Column To Columns("U").Column
    Select Case colonne
      Case 19: titi = 0
      Case 20: titi = 52
      Case 21: titi = 108
    End Select
    For i = 4 To 15
      If Cells(i, colonne).Value = 1 Then
        toto = (i + 9) + i Mod 4 + titi
        Range("A" & toto & ":A" & toto + 1).Interior.Color = vbYellow
      End If
    Next
  Next


____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

lefou63a · Answer

Salut. 

Merci pour les réponses. 

En vrai, au départ je voulais poster dans la section débutant parce que je connais vraiment qu'un petit peu mais je me suis mélanger quelque part 

Ensuite, j'essayais de comprendre ton premier message.
Mais enfaite ça fait pas comme mon truc du départ. Ca surligne ou il faut pas. Avec ton "script" ça surligne la ligne 22222 T
et moi je voudrais obtenir ceci :


J'ai essayé de regarder, mais je comprend pas beaucoup :( Je vous remercie de votre aide.

Cordialement

ucfoutu · Answer

Le code que je t'ai montré correspond à ce que tu as exposé dans ton message de demande. Je l'ai testé 
Tu sembles maintenant dire que ce n'est pas ce que tu souhaitais ! Et tu ajoutes d'autres choses !
Bonne nuit, alors.

____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

lefou63a · Answer

Si j'ai demandé ça au départ.
Que quand un 1 apparait dans une cellule, une autre cellule dois se surligner.

Ta solution me surligne en décalé par rapport a ce que j'ai demandé :|

lefou63a · Answer

Ou alors j'ai un truc que je fais pas correctement :(

Néanmoins, merci et bonne nuit.

lefou63a · Answer

Merci, ça fonctionne très bien :D

Bonne soirée.

lefou63a · Answer

Salut,

Et si le 1 se situe dans une cellule sur une autre feuille comment ça fonctionne ? C'est possible ?

Parce que j'ai essayé avec Sheets("Feuil") et des petits truc comme ça, mais ça veut pas :(
Merci
Cordialement

cs_GG72 · Answer

Bonjour,

Tout dépend de ta feuille active au moment où tu lances la macro (1er point)
et surtout si tes 1 sont placés aux mêmes endroits (meme ligne et meme colonne que dans ton exemple).
Sinon, il faut refaire la formule de calcul bien sur.

lefou63a · Answer

Merci de ta réponse.

Ca ma aider, j'ai donc fait ceci :

 
Sheets("Feuil2").Select
For colonne = Columns("E").Column To Columns("AI").Column
    For i = 0 To 11
      If Cells(i + 11, colonne).Value = 1 Then
        toto = (colonne - 5) * 54 - 41 + i * 2
        Sheets("Feuil1").Select
        Range("A" & toto & ":A" & toto + 1).Interior.Color = vbYellow

      End If
      Sheets("Feuil2").Select
    Next
  Next

Ca fonctionne 
E11 de la feuil2 =1 et A13 et A14 de la feuil1 sont surligné.

Ya t-il moyen de simplifier le calcul ?

Cordialement

cs_GG72 · Answer

Pour ma part, je supprimerais tous les Sheets("------").Select

et remplacerais
If Cells(i + 11, colonne).Value = 1 Then
par
If Sheets("Feuil2").Cells(i + 11, colonne).Value = 1 Then
puis
Range("A" & toto & ":A" & toto + 1).Interior.Color = vbYellow
par
Sheets("Feuil1").Range("A" & toto & ":A" & toto + 1).Interior.Color = vbYellow

et même remplacer 
For colonne = Columns("E").Column To Columns("AI").Column
par 
For colonne = 5 to 35

Donc en définitive:
For colonne 5 To 35  '5 colonne E  & 35 = colonne AI
    For i = 0 To 11
      If Sheets("Feuil2").Cells(i + 11, colonne).Value = 1 Then
        toto = (colonne - 5) * 54 - 41 + i * 2
        Sheets("Feuil1").Range("A" & toto & ":A" & toto + 1).Interior.Color = vbYellow
      End If
    Next
  Next

Mais à y regarder un peu plus près, j'ai un doute sur ta ligne 
toto = (colonne - 5) * 54 - 41 + i * 2

Pourquoi -5 si tu commences en colonne E ? Ce ne serait pas -4 ou alors tu commences en colonne F ????

lefou63a · Answer

Oui c'est E donc -4, j'avais modifier un truc, et après j'ai mal copier/coller le code ici :(

Et ton dernier code, ça fonctionne niquel, ya plus le changement de page, ça fonctionne super.

Merci beaucoup :D

lefou63a · Answer

Et j'ai un autre probléme (faut peut etre que je recreer un sujet ?)

Je voudrais transformer une ligne avec des X en 1 mais que quand ya pas de X bah pas de 1.

Par exemple si A3=X alors G4=1, si B3=X alors H4=1, C3=rien alors I4=Rien....

J'ai essayé ça, mais je suppose qu'il faut que j'utilise colonne= x to x, et Cells, mais j'arrive pas a faire fonctionner le truc.

  If Sheets("Feuil2").Range("A3").Value = "X" Then
      Sheets("Feuil2").Range("G4:L4").FormulaR1C1 = "1"
      End If

Bonne soirée.

lefou63a · Answer

Désolé pour le double post.

J'ai aussi essayé ça : 

Ca fonctionne mais c'est pas génial :(

    Range("A3:F3").Select
    Selection.Copy
    Range("G4").Select
    ActiveSheet.Paste
    Selection.Replace What:="X", Replacement:="1"

cs_GG72 · Answer

Tu peux essayer comme ceci:

For i = 1 To 3
  Cells(4, i + 6).Value IIf(Cells(3, i).Value "x", 1, "")
Next

à adapter suivant tes besoins.

Bonne nuit.

[Déplacé VBA -> VBS]Surligner une cellule si une cellule B = 1

17 réponses

Votre réponse

Discussions similaires