1. Ce site utilise des "témoins de connexion" (cookies) conformes aux textes de l'Union Européenne. Continuer à naviguer sur nos pages vaut acceptation de notre règlement en la matière. En savoir plus.

Sélection cellule avec condition

Discussion dans 'Forum Excel' démarrée par Florian53, 12 Octobre 2017.

  1. Florian53

    Florian53 XLDnaute Occasionnel

    Inscrit depuis le :
    26 Novembre 2008
    Messages :
    453
    "J'aime" reçus :
    2
    Bonjour,

    Je souhaiterais avoir une selection variable de cellule avec comme condition toutes les cellules commencent par A et que cette sélection soit enregistrer dans un nom.

    J'ai essayé de réaliser un code mais celui ci ne fonctionne pas, avez vous une idée ?

    Code (Visual Basic):
    Sub Test()
    Dim valeurCherchée As String
    Dim champRecherche As Range
    Dim résultat As Range

    Derniereligne = Range("A3").End(xlDown).Row


    valeurCherchée = "A*"
    Set champRecherche = Sheets("BDD").Range("A3:A" & Derniereligne)
    Set résultat = champRecherche.Find(valeurCherchée, LookIn:=xlValues, LookAt:=xlPart)
    If Not résultat Is Nothing Then
    Selection.Activate
    Selection.Name = "Selection"
    End If
    End Sub

    Merci
     
    Dernière édition: 12 Octobre 2017
  2. pierrejean

    pierrejean XLDnaute Barbatruc

    Inscrit depuis le :
    19 Janvier 2006
    Messages :
    14849
    "J'aime" reçus :
    464
    Habite à:
    69400 LIMAS
    Utilise:
    Excel 2010 (PC)
    Bonjour Florian

    A tester:

    Code (Text):

    Sub Test()
    Dim valeurCherchée As String
    Dim champRecherche As Range
    Dim résultat As Range
    Dim zone As Range
    Derniereligne = Range("A" & Rows.Count).End(xlUp).Row
    valeurCherchée = "A*"
    Set champRecherche = Sheets("BDD").Range("A3:A" & Derniereligne)
    Set résultat = champRecherche.Find(valeurCherchée, LookIn:=xlValues, LookAt:=xlPart)
    If Not résultat Is Nothing Then
            firstAddress = résultat.Address
            Do
                  If Not zone Is Nothing Then
                      Set zone = Application.Union(zone, résultat)
                   Else
                       Set zone = résultat
                    End If
                Set résultat = champRecherche.FindNext(résultat)
            Loop While Not résultat Is Nothing And résultat.Address <> firstAddress
        End If
        zone.Select
        zone.Name = "Selection"
    End Sub
     
     
  3. job75

    job75 XLDnaute Barbatruc

    Inscrit depuis le :
    15 Mai 2008
    Messages :
    23370
    "J'aime" reçus :
    1745
    Sexe :
    Masculin
    Habite à:
    Paris
    Utilise:
    Excel 2013 (PC)
    Bonjour Florian53, Pierre,
    Code (Text):
    Sub NommerPlage()
    Dim valeurCherchée$, champRecherche As Range, t
    valeurCherchée = "A*"
    With Sheets("BDD")
      If .FilterMode Then .ShowAllData 'si la feuille est filtrée
      Set champRecherche = .Range("A3", .[A3].End(xlDown))
      t = champRecherche 'mémorisation
      Application.ScreenUpdating = False
      champRecherche.Replace valeurCherchée, "#N/A", xlWhole, MatchCase:=True 'la casse est respectée
      On Error Resume Next
      ThisWorkbook.Names("Selection").Delete 'RAZ
      champRecherche.SpecialCells(xlCellTypeConstants, 16).Name = "Selection"
      champRecherche = t 'restitution
    End With
    End Sub
    Comme toutes les formules, celle définissant le nom "Selection" est limitée à 8192 caractères.

    A+
     
  4. job75

    job75 XLDnaute Barbatruc

    Inscrit depuis le :
    15 Mai 2008
    Messages :
    23370
    "J'aime" reçus :
    1745
    Sexe :
    Masculin
    Habite à:
    Paris
    Utilise:
    Excel 2013 (PC)
    Re,

    Au post précédent j'ai supposé que champRecherche ne contient que des constantes.

    S'il peut y avoir des formules utiliser cette macro :
    Code (Text):
    Sub NommerPlage()
    Dim valeurCherchée$, champRecherche As Range, t
    valeurCherchée = "A*"
    With Sheets("BDD")
      If .FilterMode Then .ShowAllData 'si la feuille est filtrée
      Set champRecherche = .Range("A3", .[A3].End(xlDown))
      t = champRecherche.Formula 'mémorisation des constantes et formules
      Application.ScreenUpdating = False
      champRecherche = champRecherche.Value 'suppression des formules
      champRecherche.Replace valeurCherchée, "#N/A", xlWhole, MatchCase:=True 'la casse est respectée
      On Error Resume Next
      ThisWorkbook.Names("Selection").Delete 'RAZ
      champRecherche.SpecialCells(xlCellTypeConstants, 16).Name = "Selection"
      champRecherche = t 'restitution
    End With
    End Sub
    qui fonctionne dans tous les cas de figure.

    A+
     
  5. job75

    job75 XLDnaute Barbatruc

    Inscrit depuis le :
    15 Mai 2008
    Messages :
    23370
    "J'aime" reçus :
    1745
    Sexe :
    Masculin
    Habite à:
    Paris
    Utilise:
    Excel 2013 (PC)
    Re,

    S'il n'est pas nécessaire de respecter la casse, le filtre automatique est une excellente solution :
    Code (Text):
    Sub NommerPlageFiltre()
    Dim valeurCherchée$, champRecherche As Range
    valeurCherchée = "A*"
    Application.ScreenUpdating = False
    With Sheets("BDD")
      If .FilterMode Then .ShowAllData 'si la feuille est filtrée
      Set champRecherche = .Range("A3", .[A3].End(xlDown))
      If IsEmpty(champRecherche(0)) Then champRecherche(0) = Chr(1) 'titre provisoire
      .Range(champRecherche(0), champRecherche).AutoFilter 1, valeurCherchée 'filtre automatique
      On Error Resume Next
      ThisWorkbook.Names("Selection").Delete 'RAZ
      champRecherche.SpecialCells(xlCellTypeVisible).Name = "Selection"
      .AutoFilterMode = False 'retire le filtre automatique
      If champRecherche(0) = Chr(1) Then champRecherche(0) = Empty
    End With
    End Sub
    A+
     
    Dernière édition: 12 Octobre 2017
  6. Florian53

    Florian53 XLDnaute Occasionnel

    Inscrit depuis le :
    26 Novembre 2008
    Messages :
    453
    "J'aime" reçus :
    2
    Bonsoir,

    Cette solution ci dessus fonctionne parfaitement, comme je dois respecter les cases.

    Merci à vs et bonne soirée
     
  7. Florian53

    Florian53 XLDnaute Occasionnel

    Inscrit depuis le :
    26 Novembre 2008
    Messages :
    453
    "J'aime" reçus :
    2
    Bonjour, j'ai re testé cette solution car je croyais avoir un résultat filtré sans doublons mais à priori ce n'est pas le cas.
    Est possible d'avoir cette sélection filtré sans doublons ?

    Merci
     
  8. Florian53

    Florian53 XLDnaute Occasionnel

    Inscrit depuis le :
    26 Novembre 2008
    Messages :
    453
    "J'aime" reçus :
    2
    Du coup j'ai appliqué ce code :

    Code (Visual Basic):
    Sub Création_Ma_Liste()

    'S'assure qu'il n'y a pas déjà des vieilles données
    'sur la plage de résultat.
    Feuil4.Range("A:A").Clear

    With Sheets("BDD")

    With .Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
    'Effectue un filtre élaboré pour enlever les doublons
    'et copie le résultat sur la feuil2
    .AdvancedFilter xlFilterCopy, , Feuil4.Range("a1"), True
    End With
    End With
    With Feuil4
    With Feuil4.Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
    'Tri le résultat du filtre en ordre croissant
    .Sort .Item(1, 1), xlAscending, , , , , , xlNo
    'Affecte un NOM à la plage de résultat
    .Name = "MaListe"
    End With
    'masque la feuille et elle est inaccesible par
    'l'interface de la feuille de calcul.
    '.Visible = xlSheetVeryHidden
    End With

    End Sub
     
    et par la suite j'ai utilisé celui ci :

    Code (Visual Basic):
    Sub NommerPlageFiltre()
    Dim valeurCherchée$, champRecherche As Range
    valeurCherchée = "A*"
    Application.ScreenUpdating = False
    With Sheets("BDD")
      If .FilterMode Then .ShowAllData 'si la feuille est filtrée
      Set champRecherche = .Range("A3", .[A3].End(xlDown))
      If IsEmpty(champRecherche(0)) Then champRecherche(0) = Chr(1) 'titre provisoire
      .Range(champRecherche(0), champRecherche).AutoFilter 1, valeurCherchée 'filtre automatique
      On Error Resume Next
      ThisWorkbook.Names("Selection").Delete 'RAZ
      champRecherche.SpecialCells(xlCellTypeVisible).Name = "Selection"
      .AutoFilterMode = False 'retire le filtre automatique
      If champRecherche(0) = Chr(1) Then champRecherche(0) = Empty
    End With
    End Sub
    ça à l'air de fonctionner ;)
     
  9. job75

    job75 XLDnaute Barbatruc

    Inscrit depuis le :
    15 Mai 2008
    Messages :
    23370
    "J'aime" reçus :
    1745
    Sexe :
    Masculin
    Habite à:
    Paris
    Utilise:
    Excel 2013 (PC)
    Bonjour Florian53,

    Le filtre automatique ne permet pas d'éliminer les doublons.

    Pour y parvenir on peut compléter le filtrage avec le Dictionary :
    Code (Text):
    Sub NommerPlageFiltreAuto()
    Dim valeurCherchée$, champRecherche As Range, d As Object, c As Range, P As Range
    valeurCherchée = "A*"
    Application.ScreenUpdating = False
    With Sheets("BDD")
      If .FilterMode Then .ShowAllData 'si la feuille est filtrée
      Set champRecherche = .Range("A3", .[A3].End(xlDown))
      If IsEmpty(champRecherche(0)) Then champRecherche(0) = Chr(1) 'titre provisoire
      .Range(champRecherche(0), champRecherche).AutoFilter 1, valeurCherchée 'filtre automatique
      On Error Resume Next
      ThisWorkbook.Names("Selection").Delete 'RAZ
      champRecherche.SpecialCells(xlCellTypeVisible).Name = "Selection"
      .AutoFilterMode = False 'retire le filtre automatique
      If champRecherche(0) = Chr(1) Then champRecherche(0) = Empty
      '---élimination des doublons---
      Set d = CreateObject("Scripting.Dictionary")
      d.CompareMode = vbTextCompare 'la casse est ignorée
      For Each c In .Range("Selection")
        If Not d.exists(c.Value) Then d(c.Value) = "": Set P = Union(IIf(P Is Nothing, c, P), c)
      Next
      P.Name = "Selection"
    End With
    End Sub
    Ou alors plus simplement utiliser le filtre avancé avec l'argument Unique à True :
    Code (Text):
    Sub NommerPlageFiltreAvancé()
    Dim valeurCherchée$, champRecherche As Range, mem$
    valeurCherchée = "A*"
    Application.ScreenUpdating = False
    With Sheets("BDD")
      If .FilterMode Then .ShowAllData 'si la feuille est filtrée
      Set champRecherche = .Range("A3", .[A3].End(xlDown))
      If IsEmpty(champRecherche(0)) Then champRecherche(0) = Chr(1) 'titre provisoire
      mem = .[B3].Formula 'mémorisation
      .[B3] = "=SEARCH(""" & valeurCherchée & """,A3)=1" 'critère du filtre
      .Range(champRecherche(0), champRecherche).AdvancedFilter xlFilterInPlace, .[B2:B3], Unique:=True 'filtre avancé sans doublon
      On Error Resume Next
      ThisWorkbook.Names("Selection").Delete 'RAZ
      champRecherche.SpecialCells(xlCellTypeVisible).Name = "Selection"
      .ShowAllData
      .[B3] = mem
      If champRecherche(0) = Chr(1) Then champRecherche(0) = Empty
    End With
    End Sub
    A+
     
  10. job75

    job75 XLDnaute Barbatruc

    Inscrit depuis le :
    15 Mai 2008
    Messages :
    23370
    "J'aime" reçus :
    1745
    Sexe :
    Masculin
    Habite à:
    Paris
    Utilise:
    Excel 2013 (PC)
    Re,

    J'ai cru comprendre que vous vouliez respecter la casse, alors voici 2 macros très simples :
    Code (Text):
    Sub NommerPlageAvecDoublon()
    Dim valeurCherchée$, champRecherche As Range, c As Range, P As Range
    valeurCherchée = "A*"
    With Sheets("BDD")
      If .FilterMode Then .ShowAllData 'si la feuille est filtrée
      Set champRecherche = Intersect(.Range("A3", .[A3].End(xlDown)), .UsedRange)
    End With
    On Error Resume Next
    For Each c In champRecherche
      If c Like valeurCherchée Then Set P = Union(IIf(P Is Nothing, c, P), c)
    Next
    ThisWorkbook.Names("Selection").Delete 'RAZ
    P.Name = "Selection"
    End Sub

    Sub NommerPlageSansDoublon()
    Dim valeurCherchée$, champRecherche As Range, d As Object, c As Range, P As Range
    valeurCherchée = "A*"
    With Sheets("BDD")
      If .FilterMode Then .ShowAllData 'si la feuille est filtrée
      Set champRecherche = Intersect(.Range("A3", .[A3].End(xlDown)), .UsedRange)
    End With
    Set d = CreateObject("Scripting.Dictionary")
    On Error Resume Next
    For Each c In champRecherche
      If c Like valeurCherchée Then If Not d.exists(c.Value) Then _
        d(c.Value) = "": Set P = Union(IIf(P Is Nothing, c, P), c)
    Next
    ThisWorkbook.Names("Selection").Delete 'RAZ
    P.Name = "Selection"
    End Sub
    La 1ère macro fait le même travail que celle du post #4 mais elle utilise une boucle...

    A+
     
    Dernière édition: 13 Octobre 2017

Partager cette page