Microsoft 365 CurrentRegion : sélection de cellules

Usine à gaz · 30 Novembre 2021

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,

job75 · 30 Novembre 2021

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

Usine à gaz · 30 Novembre 2021

Re-Bonjou Sylvanu, Bruno45, le Forum,

Je pense que comme ça ça doit être bon.
Fichier joint,
Qu'en pensez-vous ?
lionel,

Usine à gaz · 30 Novembre 2021

Et ça me permets de mettre des validation sur les cellules sélectionnées et d'y faire encore d'autres trucs dont j'ai besoin
Voir pièce jointe,
lionel

sylvanu · 30 Novembre 2021

Oui, mais comme la colonne P est vide, je n'ai toujours rien compris au but.

Usine à gaz · 30 Novembre 2021

Dans un 1er temps, remplir les cellules avec la validation

job75 · 30 Novembre 2021

Bonsoir Lionel, Bruno, sylvanu,

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

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+

job75 · 30 Novembre 2021

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

Usine à gaz · 30 Novembre 2021

Bonjour Gérard,

Je te remercie une fois de plus.
C'est nickel
lionel,

Usine à gaz · 30 Novembre 2021

Waoooo !!!,
J'sais pas les faire comme ça mais je note lol,
Merci encore Gérard, c'est complet,
lionel

Usine à gaz · 30 Novembre 2021

Bonsoir laurent,

Merci pour ce code que je garde également
Bonne fin de journée,
lionel,

laurent950 · 30 Novembre 2021

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 · 30 Novembre 2021

Merci Laurent

Usine à gaz · 30 Novembre 2021

Bonsoir Gérard (job75),
J'aurais encore besoin d'un p'tit coup de code :

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

job75 · 30 Novembre 2021

Usine à gaz à dit:
Je cherche à ne filtrer que sur les cellules qui contiennent uniquement "RdV Fait",

Allons Lionel... Dans la macro du post #21 enlève l'astérisque * à droite de "RDV Fait" !

Bonne nuit.

TooFatBoy · 1 Décembre 2021

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 · 1 Décembre 2021

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

Microsoft 365 CurrentRegion : sélection de cellules

Usine à gaz

XLDnaute Barbatruc

Pièces jointes

job75

Usine à gaz

XLDnaute Barbatruc

Pièces jointes

Usine à gaz

XLDnaute Barbatruc

Pièces jointes

sylvanu

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

Usine à gaz

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

laurent950

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

TooFatBoy

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

Discussions similaires