Selection multiple en fonction d'une boucle

[christ-94]

Bonjour

Voila , non code va dans une macro plus complète , le but est de colorier une sélection multiple en fonction d'une boucle
Si dans la range 6 j'ai un D je colories la sélection multiple qui se trouve en desous .la selection est (E9:E15,E17:E18,E21:E22) car il y a un D en E6
Et je bloque sur la sélection multiple
Je ne souhaite pas utilise de MFC

Sub test2()
Dim boucle As Variant
For boucle = 1 To 10
t = Intersect(Columns(boucle), Rows(6))
If t = "D" Then
Range(boucle & "5").Select 'deja probleme sur une selection

With Selection.Interior
.ColorIndex = 4
.Pattern = xlSolid
End With
Else
Range("a22") = "toto"
End If
Next
End Sub

la selection multiple a adapte est la

Range(boucle & "5").Select
Range("E9:E15,E17:E18,E21:E22").Select

Merci d'avance

 

[wilfried_42]

Re : Selection multiple en fonction d'une boucle

bonjour christ-94

il serait interressant d'avoir un exemple fichier, parce que je pense que ce n'est pas la seule cellule qui doit affecter une couleur

 

[mutzik]

Re : Selection multiple en fonction d'une boucle

bonjour,

essaie le code suivant

Sub test2()
Dim boucle As Variant, t
For boucle = 1 To 10
t = Intersect(Columns(boucle), Rows(6))
If t = "D" Then
Range(Range(Chr(boucle + 64) & "5").Value).Select
With Selection.Interior
.ColorIndex = 4
.Pattern = xlSolid
End With
Else
Range("a22") = "toto"
End If
Next
End Sub
en mettant en ligne 5 (audessus de 'D') le range qui doit être colorié (écrire le tout en format texte)

 

[christ-94]

Re : Selection multiple en fonction d'une boucle

Ci-joint le fichier exemple

Regarde la pièce jointe Couleur.zip

Merci

 

[christ-94]

Re : Selection multiple en fonction d'une boucle

Merci mutzik

Mais , j'ai toujours une erreur sur la ligne

Range(Range(Chr(boucle + 64) & "5").Value).Select

fonctionne avec le code

Range(Chr(boucle + 64) & "5" ).Select

Sur une case et non sur une selection multiple

de type

Range("E9:E15,E17:E18,E21:E22").Select

 

[mutzik]

Re : Selection multiple en fonction d'une boucle

curieux, chez moi mon code fonctionne

teste le fichier stp

 

[christ-94]

Re : Selection multiple en fonction d'une boucle

Merci le fichier fonctionne

Mais il a un problème, il ne colorie les cellules que si on les mais sur la range 5
Le but et de colorier les cellule en dessous du D, elle ne doivent pas être sur la feuille

Comme dans le fichier exemple

 

[mutzik]

Re : Selection multiple en fonction d'une boucle

désolé, j'avais pas ouvert ton fichier

voici ce qui devrait te convenir

 

[christ-94]

Re : Selection multiple en fonction d'une boucle

Un grand merci a toi et au forum

depuis plus de 3 heure je cherche et l'erreur été le : que je voulais a l'extérieur des " donc une erreur

 

[christ-94]

Re : Selection multiple en fonction d'une boucle

De retour

car il y a encore un probleme desole

Lors du passage sur une colonne de type AA du fait de la convertion, la macro plante

t = Chr(64 + cpt)

 

[wilfried_42]

Re : Selection multiple en fonction d'une boucle

re:


au lieu de range( chr(boucle + 64),ligne) utilise cells(ligne,boucle)

c'est la meme chose : exemple

range(cells(ligne,boucle).value).value = "Essai " & boucle & " " & ligne

 

[christ-94]

Re : Selection multiple en fonction d'une boucle

Une solution

Function ColumnLetter()
Dim C As Integer, L As Integer
With ActiveCell
C = .Column
If C > 26 Then L = 2 Else L = 1
ColumnLetter = Left$(.Address(0, 0), L)
End With
End Function



Sub Colorie_Samedi_Dimance()
Dim cpt As Variant, t, X
    Range("D5:AK39").Select
    Range("AK39").Activate
    Selection.Interior.ColorIndex = xlNone

For cpt = 1 To 40

    t = Intersect(Columns(cpt), Rows(6))
    If t = "D" Then
    
        Point = Intersect(Columns(cpt), Rows(6)).Select
        t = ColumnLetter
               
        Range(t & "5:" & t & "18," & t & "20:" & t & "23," & t & "25:" & t & "31," & t & "33," & t & "36:" & t & "39").Select
        With Selection
            .Interior.Pattern = xlSolid
            .Interior.ColorIndex = 4
        End With
    Else
    End If
        If t = "S" Then
        
        Point = Intersect(Columns(cpt), Rows(6)).Select
        t = ColumnLetter
        
        Range(t & "5:" & t & "18," & t & "20:" & t & "23," & t & "25:" & t & "31," & t & "33," & t & "36:" & t & "39").Select
        With Selection
            .Interior.Pattern = xlSolid
            .Interior.ColorIndex = 4
        End With
    Else
    End If
 
Next
End Sub