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

lefou63a 12 Messages postés mardi 22 novembre 2005Date d'inscription 26 octobre 2011 Dernière intervention - 4 oct. 2011 à 18:03 - Dernière réponse : cs_GG72 94 Messages postés vendredi 13 mai 2005Date d'inscription 30 octobre 2011 Dernière intervention
- 5 oct. 2011 à 22:39
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
Afficher la suite 

Votre réponse

17 réponses

Meilleure réponse
cs_GG72 94 Messages postés vendredi 13 mai 2005Date d'inscription 30 octobre 2011 Dernière intervention - 4 oct. 2011 à 21:41
3
Merci
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.

Merci cs_GG72 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 119 internautes ce mois-ci

Commenter la réponse de cs_GG72
ucfoutu 18039 Messages postés lundi 7 décembre 2009Date d'inscriptionContributeurStatut 11 avril 2018 Dernière intervention - 4 oct. 2011 à 18:30
0
Merci
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
Commenter la réponse de ucfoutu
cs_GG72 94 Messages postés vendredi 13 mai 2005Date d'inscription 30 octobre 2011 Dernière intervention - 4 oct. 2011 à 18:34
0
Merci
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.
Commenter la réponse de cs_GG72
ucfoutu 18039 Messages postés lundi 7 décembre 2009Date d'inscriptionContributeurStatut 11 avril 2018 Dernière intervention - 4 oct. 2011 à 19:37
0
Merci
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
Commenter la réponse de ucfoutu
lefou63a 12 Messages postés mardi 22 novembre 2005Date d'inscription 26 octobre 2011 Dernière intervention - 4 oct. 2011 à 21:00
0
Merci
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
Commenter la réponse de lefou63a
ucfoutu 18039 Messages postés lundi 7 décembre 2009Date d'inscriptionContributeurStatut 11 avril 2018 Dernière intervention - 4 oct. 2011 à 21:13
0
Merci
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
Commenter la réponse de ucfoutu
lefou63a 12 Messages postés mardi 22 novembre 2005Date d'inscription 26 octobre 2011 Dernière intervention - 4 oct. 2011 à 21:25
0
Merci
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é :|
Commenter la réponse de lefou63a
lefou63a 12 Messages postés mardi 22 novembre 2005Date d'inscription 26 octobre 2011 Dernière intervention - 4 oct. 2011 à 21:30
0
Merci
Ou alors j'ai un truc que je fais pas correctement :(

Néanmoins, merci et bonne nuit.
Commenter la réponse de lefou63a
lefou63a 12 Messages postés mardi 22 novembre 2005Date d'inscription 26 octobre 2011 Dernière intervention - 4 oct. 2011 à 22:04
0
Merci
Merci, ça fonctionne très bien :D

Bonne soirée.
Commenter la réponse de lefou63a
lefou63a 12 Messages postés mardi 22 novembre 2005Date d'inscription 26 octobre 2011 Dernière intervention - 5 oct. 2011 à 16:05
0
Merci
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
Commenter la réponse de lefou63a
cs_GG72 94 Messages postés vendredi 13 mai 2005Date d'inscription 30 octobre 2011 Dernière intervention - 5 oct. 2011 à 16:50
0
Merci
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.
Commenter la réponse de cs_GG72
lefou63a 12 Messages postés mardi 22 novembre 2005Date d'inscription 26 octobre 2011 Dernière intervention - 5 oct. 2011 à 17:40
0
Merci
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
Commenter la réponse de lefou63a
cs_GG72 94 Messages postés vendredi 13 mai 2005Date d'inscription 30 octobre 2011 Dernière intervention - 5 oct. 2011 à 18:58
0
Merci
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 ????
Commenter la réponse de cs_GG72
lefou63a 12 Messages postés mardi 22 novembre 2005Date d'inscription 26 octobre 2011 Dernière intervention - 5 oct. 2011 à 20:58
0
Merci
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
Commenter la réponse de lefou63a
lefou63a 12 Messages postés mardi 22 novembre 2005Date d'inscription 26 octobre 2011 Dernière intervention - 5 oct. 2011 à 22:01
0
Merci
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.
Commenter la réponse de lefou63a
lefou63a 12 Messages postés mardi 22 novembre 2005Date d'inscription 26 octobre 2011 Dernière intervention - 5 oct. 2011 à 22:07
0
Merci
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"
Commenter la réponse de lefou63a
cs_GG72 94 Messages postés vendredi 13 mai 2005Date d'inscription 30 octobre 2011 Dernière intervention - 5 oct. 2011 à 22:39
0
Merci
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.
Commenter la réponse de cs_GG72

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.