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 à 11:49.

  1. Florian53

    Florian53 XLDnaute Occasionnel

    Inscrit depuis le :
    26 Novembre 2008
    Messages :
    427
    "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 à 13:06
  2. pierrejean

    pierrejean XLDnaute Barbatruc

    Inscrit depuis le :
    19 Janvier 2006
    Messages :
    14776
    "J'aime" reçus :
    441
    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 :
    23103
    "J'aime" reçus :
    1704
    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 :
    23103
    "J'aime" reçus :
    1704
    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 :
    23103
    "J'aime" reçus :
    1704
    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 à 18:10
  6. Florian53

    Florian53 XLDnaute Occasionnel

    Inscrit depuis le :
    26 Novembre 2008
    Messages :
    427
    "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 :
    427
    "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 :
    427
    "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 :
    23103
    "J'aime" reçus :
    1704
    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 :
    23103
    "J'aime" reçus :
    1704
    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 à 21:16

Partager cette page