XL 2016 Sélectionner toutes les cellules dans une plage donnée

[aimache]

Bonjour à tous.
Je viens vers vous pour savoir comment faire pour sélectionner avec une macro l'ensemble des cellules dans une plage donnée ayant le même contenu que la cellule active en gardant la cellule active sélectionnée également.
J'ai bien réussi à mettre un petit bout de code qui me trouve et sélectionne une cellule, mais :
1 : il ne garde pas la cellule active sélectionnée...
2 : il ne sélectionne toutes les cellules aux mêmes valeurs, une seule est sélectionnée...

Ça fait beaucoup d'incompétence tout ça, je sais...

Pourriez-vous m'apporter votre aide ?
J'ajoute un fichier exemple avec deux feuilles. La première montre ce que j'obtiens actuellement, la deuxième montre ce que je souhaiterais obtenir. (sur la deuxième feuille, j'ai grisé les cellules pour exemple de sélection)

Merci par avance à tous ceux qui auront la gentilesse de poser un regard sur ma requête.

 

[chris]

Bonjour

Quelle est la finalité de la sélection, sachant qu'en VBA on évite justement la sélection ?

 

[aimache]

Bonjour.
Pour plusieurs raisons...
Déjà, pour les visualiser, les repérer...parce que mon envoi n'est qu'un exemple succinct d'un fichier avec des plages plus conséquentes...
Aussi pour pouvoir ensuite apporter d'éventuelles modifications ....même (et je sais que c'est presque un gros mot) éventuellement fusionner les cellules qui seraient adjacentes...toutes sortes de choses..
Mais peut-être est-ce tout simplement impossible ?

 

[chris]

RE

• il est plus visuel de les repérer par une couleur d'autant que la cellule active d'une sélection multiple n'est pas colorée en gris...
• on n'a pas besoin de sélectionner pour modifier par VBA
• la fusion n'est pas un gros mot mais le début des emm...dements (copie, tri, filtre, souvent impossibles, formules et VBA plus compliqués...) alors que dans 95% des cas on peut se passer de la fusion pour un aspect visuel similaire

Mais si tu y tiens

Option Explicit
Sub rech()
Dim Plage As Range, suite As Range, Valeur, debut As String

If ActiveCell.Value = "" Or Selection.Cells.Count > 1 Then
        MsgBox ("Il n'y a pas de valeur à chercher")
        Exit Sub
    End If
    Valeur = Selection.Value
    With ActiveSheet.Range("A1:G10")
        Set suite = .Find(Valeur, , xlValues, xlWhole)
        debut = suite.Address
        Set Plage = Selection
        Do
            If Not suite Is Nothing Then Set Plage = Application.Union(Plage, suite)
            Set suite = .FindNext(suite)
        Loop Until suite Is Nothing Or suite.Address = debut
    End With
    Plage.Select
End Sub

 

[fanch55]

Bonjour à tous

Sub Rech()
Dim Zone        As Range
Dim RFind       As Range
Dim Selected    As String
Dim FirstAdr    As String

    If ActiveCell.Value = "" Then
        MsgBox ("Il n'y a pas de valeur à chercher")
    Else
        Set Zone = ActiveCell
        Selected = ActiveCell.Value
        With Range("A1:G10")
            Set RFind = .Find(Selected, , xlValues, xlWhole)
            Do While Not RFind Is Nothing
                If FirstAdr = "" Then FirstAdr = RFind.Address
                Set Zone = Union(Zone, RFind)
                Set RFind = .FindNext(RFind)
                If RFind.Address = FirstAdr Then Set RFind = Nothing
            Loop
            Zone.Select
        End With
    End If
  
End Sub

@chris : mince on s'est croisé

Effectivement, ne pas oublier le
Selection.Cells.Count > 1

 

[fanch55]

Si effet uniquement visuel, on peut se servir des MFC .
A mettre dans le code de la feuille concernée :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    With Range("A1:G10")
        If Target.Count = 1 And Not Intersect(Target, .Cells) Is Nothing Then
            .FormatConditions.Delete
            .FormatConditions.Add xlCellValue, xlEqual, "=" & Target.Value
            For Each Elem In Array(xlTop, xlBottom, xlLeft, xlRight)
                .FormatConditions(1).Borders(Elem).LineStyle = xlContinuous
            Next
        End If
    End With
End Sub

 

[aimache]

Merci à tous.
Vous êtes trop sympathiques et super efficaces.
Chris et Franch55, j'ai essayé vos deux solutions, et c'est parfait pour les deux
Pour info, le grisé de mon mesage initial était uniquement pour "simuler" la sélection des cellules.
La couleur n'était pas le sujet.

Merci beaucoup encore, vous avez parfaitement répondu à mes attentes.

Trop forts !!!
Je ne sais pas comment vous faites pour fermer ce fil.

 

[Staple1600]

Bonjour le fil

=>fanch55
Si j'ai bien compris
On peut ne pas boucler

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    With Range("A1:G10")
        If Target.Count = 1 And Not Intersect(Target, .Cells) Is Nothing Then
            .FormatConditions.Delete
            .FormatConditions.Add xlCellValue, xlEqual, "=" & Target.Value
            .FormatConditions(1).Borders.LineStyle = 1
        End If
    End With
End Sub

 

[fanch55]

Bonjour le fil

=>fanch55
Si j'ai bien compris
On peut ne pas boucler

            .FormatConditions(1).Borders.LineStyle = 1

Merci @Staple1600 , je connaissais le borderaround pour une cellule/range et je ne comprenais pas pourquoi le formatcondition n'avait pas l'équivalent.
Je stocke l'info dans un coin de ma mémoire ...