Simplifier ligne de code macro

[gourdin]

Bonjour,

Le mieux est de voir l'exemple simplifié joint

Merci

 

[ERIC S]

Re : Simplifier ligne de code macro

Bonjur

a essayer

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If LCase(Target.Value) = "clic" Then
ligne = Target.Row
If LCase(Target.Offset(-1, 0).Value) = "clic" Then ligne = ligne - 1
If LCase(Target.Offset(-2, 0).Value) = "clic" Then ligne = ligne - 1
Range("B" & ligne & ":B" & ligne + 5 & ",D" & ligne - 2).Select
End If
End Sub

 

[Cousinhub]

Re : Simplifier ligne de code macro

Bonsoir,

Bonsoir, Eric S

une autre proposition :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count = 1 Then
    If Target.Column = 4 And Target.Interior.ColorIndex = 35 And Target.Row > 2 Then
        coul = 35
        nb1 = cpt1(Target.Offset(-2, 0).Resize(3, 1), coul)
        Target.Offset(1 - nb1, -2).Resize(6, 1).Select
    End If
End If
End Sub
Function cpt1(Plg As Range, coul)
    For Each Cel In Plg
        If Cel.Interior.ColorIndex = coul Then
            cpt1 = cpt1 + 1
        End If
    Next Cel
End Function

Suppose que les cellules dans la colonne D sont de couleur identique à ton fichier....

 

[kjin]

Re : Simplifier ligne de code macro

Bonsoir,
Pour le fun et éviter les boucles

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 4 And Target.Interior.ColorIndex = 35 Then
    Select Case Target.Offset(1).Interior.ColorIndex
    Case 35
        If Target.Offset(2).Interior.ColorIndex = 35 Then
        Range(Cells(Target.Row, Target.Column - 2), Cells(Target.Row + 5, Target.Column - 2)).Select
        End If
        If Target.Offset(2).Interior.ColorIndex = xlNone Then
        Range(Cells(Target.Row - 1, Target.Column - 2), Cells(Target.Row + 4, Target.Column - 2)).Select
        End If
    Case xlNone
        Range(Cells(Target.Row - 2, Target.Column - 2), Cells(Target.Row + 3, Target.Column - 2)).Select
    End Select
End If
End Sub

En utilisant la couleur 35
A+
kjin

 

[gourdin]

Re : Simplifier ligne de code macro

Merci beaucoup,

Celà fonctionne mais dans mon exemple (initialement joint) les cellules à cliquer (verte) sont en fait vides et ne comportent pas le mot "clic" (qui était juste là pour la compréhension).

En nouveau fichier joint l'exemple modifié.

PS : C'était la réponse à Eric car entre temps d'autres réponses sont arrivés (merci à tous) que je vais essayer plus tard

 

[_Thierry]

Re : Simplifier ligne de code macro

Bonsoir à tous et toutes

Une autre approche sans être basée sur la String "Clic" mais sur le ColorIndex 35 pour le Vert comme mon ami Bhbh...

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim MyGreenRange As Range, MyGreenCell As Range
Dim Position As Byte
Dim TheAddress As String
Position = 0
 
If ActiveCell.Interior.ColorIndex = 35 Then
Set MyGreenCell = ActiveCell
    If MyGreenCell.Offset(-1, 0).Interior.ColorIndex = 35 Then
        If MyGreenCell.Offset(-2, 0).Interior.ColorIndex = 35 Then
            Position = 3
        Else
            Position = 2
        End If
    Else
    Position = 1
    End If
    TheAddress = MyGreenCell.Offset(-1 - Position, 0).Address(0, 0) & "," & _
                 Range(MyGreenCell.Offset(1 - Position, -2).Address(0, 0), MyGreenCell.Offset(6 - Position, -2)).Address(0, 0)

Range(TheAddress).Select
End If

Bonne soirée

@+Thierry
​

 

[gourdin]

Re : Simplifier ligne de code macro

MERCI A TOUS

Je vais pouvoir adapter vos réponses à mon document

 

[gourdin]

Re : Simplifier ligne de code macro

Bonjour à nouveau

Après avoir décidé de choisir la solution d'ERIC S, je me suis heurté à un autre petit problème.

J'ai voulu adapter la macro à mon document initial mais celà ne fonctionne pas au delà de 5 cellules (trop de "if" ?).

Voir fichier joints explicatif

MERCI

 

[ERIC S]

Re : Simplifier ligne de code macro

Bonjour

je ne comprends pas trop ce que tu veux faire avec toutes tes cases "clic". ce serait bien que tu nous expliques car cela paraît bizarre...

le problème avec l'extension que tu tentes est que si tu sélectionnes sur la ligne 5 (premier clic), quand tu fais
Target.Offset(-5, 0) tu pointes en ligne 0 (5-5) qui n'existe pas, d'où erreur

une autre approche

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If LCase(Target.Value) = "clic" Then
    'si non effectué si ligne 1
    ligne = Target.Row
    If Not ligne = 1 Then
        'boucle pour tester présence des "clic"
        For i = 1 To Target.Row
            If LCase(Target.Offset(-i, 0).Value) = "clic" Then
                ligne = ligne - 1
            Else
                i = Target.Row
            End If
        Next
    End If
    Range("B" & ligne & ":B" & ligne + 15 & ",D" & ligne - 2).Select
End If
End Sub

Si tu peux néanmoins expliquer ton problème réel 😕