Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

aimache

XLDnaute Nouveau
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.
 

Pièces jointes

  • RECH.xlsm
    21.1 KB · Affichages: 11
Solution
Bonjour à tous
VB:
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...

aimache

XLDnaute Nouveau
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

XLDnaute Barbatruc
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
VB:
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

XLDnaute Barbatruc
Bonjour à tous
VB:
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
 
Dernière édition:

fanch55

XLDnaute Barbatruc
Si effet uniquement visuel, on peut se servir des MFC .
A mettre dans le code de la feuille concernée :
VB:
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

XLDnaute Nouveau
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

XLDnaute Barbatruc
Bonjour le fil

=>fanch55
Si j'ai bien compris
On peut ne pas boucler
VB:
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
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…