Microsoft 365 CurrentRegion : sélection de cellules

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonjour à toutes et à tous,
Je vous souhaite une belle et chaude journée :)

Je n'arrive pas à adapter un code que Job75 m'a donné.
Le code était(pour appliquer une formule) :
VB:
Code origine Gérard
Sheets("Comptage_appels").Select
ActiveSheet.Unprotect Password:=""
    With [a1].CurrentRegion
    If .Rows.Count > 1 Then .Cells(4, 16).Resize(.Rows.Count - 1) = "=IF(OR(RC[-6]="""",RC[-5]=""""),"""",IF(VALUE(SUBSTITUTE(LEFT(RC[-6],8),""-"",""/"",1))=TODAY(),1,IF(MONTH(EOMONTH(VALUE(SUBSTITUTE(LEFT(RC[-6],8),""-"",""/"",1)),0))=MONTH(TODAY()),2,IF(MONTH(EOMONTH(VALUE(SUBSTITUTE(LEFT(RC[-6],8),""-"",""/"",1)),0))<MONTH(TODAY()),""3"",""""))))"
    .Columns(16) = .Columns(16).Value 'supprime les formules
    [P3] = "=SUM(RC[-4]:RC[-2])"
    End With
ActiveSheet.Protect Password:="", DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
et fonctionne très dans le fichier pour lequel il a été fait.

J'ai tenté de le modifier comme suit pour faire une sélection de cellules :
Code:
With [a6].CurrentRegion
    If .Rows.Count > 1 Then .Cells(1, 16).Resize(.Rows.Count).Select
    'If .Rows.Count > 1 Then .Cells(1, 16).Resize(.Rows.Count).Select
    '.Cells(4, 16).Resize(.Rows.Count - 1)
    End With
Mais ça ne fonctionne pas et je n'arrive pas à trouver comment faire.

J'ai besoin que seules les cellules en colonnes P avec "RdV Fait" contenu en colonne "J" soient sélectionnées.

Pourriez-vous m'aider ?
Je joins un fichier test et je continue à bidouiller ;)

Un grand merci encore une fois,
Amicalement,
lionel,
 

Pièces jointes

  • CurrentRegion.xlsm
    52.4 KB · Affichages: 13
Dernière édition:
Solution
Fichier (2) avec création des listes de validation :
VB:
Sub sélection()
    With ActiveSheet 'Feuil1 'CodeName
        If .FilterMode Then .ShowAllData 'si la feuille est filtrée
        .Columns(16).Validation.Delete 'RAZ
        With .Rows("6:" & .Range("j" & .Rows.Count).End(xlUp).Row)
            If .Row < 6 Then Exit Sub 'sécurité
            Application.ScreenUpdating = False
            .Rows.RowHeight = 55
            .Sort .Columns(10), xlAscending, Header:=xlNo 'tri
            Union(.Rows(0), .Rows).AutoFilter 10, "RDV Fait*" 'filtre automatique
            On Error Resume Next 'si aucune SpecialCell
            With Intersect(.SpecialCells(xlCellTypeVisible), .Columns(16))
                Application.Goto .Cells(1), True...

job75

XLDnaute Barbatruc
Bonsoir Lionel, Bruno, sylvanu,

Lionel depuis le temps tu devrais savoir qu'en VBA on ne sélectionne pas :rolleyes:

Mais bon, j'ai amélioré et simplifié ton code :
VB:
Sub sélection()
    With ActiveSheet 'Feuil1 'CodeName
        If .FilterMode Then .ShowAllData 'si la feuille est filtrée
        With .Rows("6:" & .Range("j" & .Rows.Count).End(xlUp).Row)
            If .Row < 6 Then Exit Sub 'sécurité
            Application.ScreenUpdating = False
            .Rows.RowHeight = 55
            .Sort .Columns(10), xlAscending, Header:=xlNo 'tri
            Union(.Rows(0), .Rows).AutoFilter 10, "RDV Fait*" 'filtre automatique
            On Error Resume Next 'si aucune SpecialCell
            Application.Goto Intersect(.SpecialCells(xlCellTypeVisible), .Columns(16)), True 'sélectionne et cadre la colonne P
            ActiveWindow.ScrollColumn = 1
            .AutoFilter 'ôte le filtre
        End With
    End With
End Sub
A+
 

Pièces jointes

  • CurrentRegion (1).xlsm
    53.4 KB · Affichages: 2

job75

XLDnaute Barbatruc
Fichier (2) avec création des listes de validation :
VB:
Sub sélection()
    With ActiveSheet 'Feuil1 'CodeName
        If .FilterMode Then .ShowAllData 'si la feuille est filtrée
        .Columns(16).Validation.Delete 'RAZ
        With .Rows("6:" & .Range("j" & .Rows.Count).End(xlUp).Row)
            If .Row < 6 Then Exit Sub 'sécurité
            Application.ScreenUpdating = False
            .Rows.RowHeight = 55
            .Sort .Columns(10), xlAscending, Header:=xlNo 'tri
            Union(.Rows(0), .Rows).AutoFilter 10, "RDV Fait*" 'filtre automatique
            On Error Resume Next 'si aucune SpecialCell
            With Intersect(.SpecialCells(xlCellTypeVisible), .Columns(16))
                Application.Goto .Cells(1), True 'sélectionne et cadre la 1ère cellule visible en colonne P
                .Validation.Add xlValidateList, Formula1:="Validé,Annulé"
            End With
            ActiveWindow.ScrollColumn = 1
            .AutoFilter 'ôte le filtre
        End With
    End With
End Sub
 

Pièces jointes

  • CurrentRegion (2).xlsm
    53.5 KB · Affichages: 5

laurent950

XLDnaute Accro
Bonsoir Lionel.

La fin fonctionne pas Lionel
C'est sur cette ligne la boucle est infini

Ca ne fonctionne pas je dois revoir, pour le reste c'est bien avec Find et FindNexr
a consigner quand même
If Sch(UBound(Sch)).Row = CLng(Split(Rgn.Address, "$")(4)) Then Exit Do
Loop While Not Sch(UBound(Sch)) Is Nothing

je poste

VB:
Sub sélection()
Dim Wks1 As Worksheet
    Set Wks1 = Worksheets("Feuil1")
    Dim Rgn As Range
        Set Rgn = Wks1.Range(Wks1.Cells(6, 10), Wks1.Cells(Wks1.Cells(1000, 10).End(xlUp).Row, 10))
    Dim Sch() As Range
    ReDim Sch(0 To 0)
    Dim Plg As String
    Dim PlgSelect As Range
    With Rgn
        Set Sch(UBound(Sch)) = .Find(What:="RdV Fait", LookIn:=xlValues)
            'MsgBox Sch(UBound(Sch)).Address
            If Not Sch(UBound(Sch)) Is Nothing Then
                Do
                    ReDim Preserve Sch(0 To UBound(Sch) + 1)
                    Set Sch(UBound(Sch)) = .FindNext(Sch(UBound(Sch) - 1))
                    'MsgBox Sch(UBound(Sch)).Address
                    If Sch(UBound(Sch)).Row = CLng(Split(Rgn.Address, "$")(4)) Then Exit Do
                    'MsgBox "stop"
                Loop While Not Sch(UBound(Sch)) Is Nothing
            End If
    End With
        For i = LBound(Sch) To UBound(Sch)
            Plg = Plg & IIf(i = UBound(Sch), Sch(i).Address, Sch(i).Address & ", ")
        Next i
        Set PlgSelect = Range(Plg)
            PlgSelect.Offset(, 6).Select
End Sub
 

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonsoir Gérard (job75),
J'aurais encore besoin d'un p'tit coup de code :
1638307947179.png

Après exécution du code, je vais avoir des cellules :
- avec RdV Fait annulé,
- avec RdV Fait Validé,
- avec RdV Fait,

Je cherche à ne filtrer que sur les cellules qui contiennent uniquement "RdV Fait",
lol, je cherche, je cherche, je cherche
lionel :)
 

TooFatBoy

XLDnaute Barbatruc
Bonjour,

Nous considérons que notre Yoyo international connait parfaitement l'utilisation des caractères jokers dont l'astérisque, mais peut-être que personne ne la lui a jamais expliquée.

L'astérisque est là pour n'importe quelle chaîne de caractères, y compris une chaîne vide (sans aucun caractère).
  • Donc si ton filtre est "RDV fait*" tu obtiendras toutes chaînes de caractères commençant par RDV fait y compris la chaîne RDV fait puisque l'astérisque remplace aussi une chaîne vide.

  • Si ton filtre est "*RDV fait" tu obtiendras toutes chaînes de caractères se terminant par RDV fait y compris la chaîne RDV fait puisque l'astérisque remplace aussi une chaîne vide.

  • Si ton filtre est "*RDV fait*" tu obtiendras toutes chaînes de caractères contenant RDV fait y compris la chaîne RDV fait puisque l'astérisque remplace aussi une chaîne vide.

  • Si ton filtre est "RDV fait" tu obtiendras uniquement les chaînes de caractères qui sont exactement RDV fait puisqu'il n'y a pas de joker dans le filtre.
 

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonjour Gérard, Bonjour Marcel, le Forum,

"Allons Lionel... Dans la macro du post #21 enlève l'astérisque * à droite de "RDV Fait" !"
VB:
Sub sélection()
    With ActiveSheet 'Feuil1 'CodeName
        If .FilterMode Then .ShowAllData 'si la feuille est filtrée
        .Columns(16).Validation.Delete 'RAZ
        With .Rows("6:" & .Range("j" & .Rows.Count).End(xlUp).Row)
            If .Row < 6 Then Exit Sub 'sécurité
            Application.ScreenUpdating = False
            .Rows.RowHeight = 55
            .Sort .Columns(10), xlAscending, Header:=xlNo 'tri
            Union(.Rows(0), .Rows).AutoFilter 10, "RDV Fait"
            'Union(.Rows(0), .Rows).AutoFilter 10, "RDV Fait*" 'filtre automatique
            On Error Resume Next 'si aucune SpecialCell
            With Intersect(.SpecialCells(xlCellTypeVisible), .Columns(16))
                Application.Goto .Cells(1), True 'sélectionne et cadre la 1ère cellule visible en colonne P
                .Validation.Add xlValidateList, Formula1:="Validé,Annulé"
            End With
            ActiveWindow.ScrollColumn = 1
            .AutoFilter 'ôte le filtre
        End With
        End With
End Sub
C'est ce que j'ai fait en premier mais ça ne fonctionne pas il me sélectionne toujours :
- avec RdV Fait annulé,
- avec RdV Fait Validé,
- avec RdV Fait,
lionel :)
 

Discussions similaires

Réponses
11
Affichages
396

Statistiques des forums

Discussions
311 725
Messages
2 081 940
Membres
101 845
dernier inscrit
annesof