Macro : sélection ligne sous contrainte

Le 09/08/2018 à 13:15

Et encore une pour améliorer l'amélioration de l'amélioration...

Même principe que ma dernière quant à la succession des sélections mais ici, tu peux ne sélectionner que quelques colonnes ou, comme "avant", les lignes entières.

Dans le cas de sélection de lignes partielles, la macro, forcément, ne supprime pas les blocs mais efface leur contenu.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
With Selection
    iOK = 0
    Select Case .Areas.Count
        Case 2
            If .Areas(1).Rows.Count = .Areas(2).Rows.Count Then iOK = 1
        Case 3
            If .Areas(2).Rows.Count = .Areas(3).Rows.Count Then iOK = 2
    End Select
    If iOK > 0 Then
        iStart = .Areas(iOK).Row
        iStep = .Areas(iOK + 1).Row - .Areas(iOK).Row
        iRows = .Areas(iOK).Rows.Count
        lEnd = IIf(iOK = 1, UsedRange.Rows.Count, .Areas(1).Row - 1)
        Set rCells = Rows(UsedRange.Rows.Count + 1).EntireRow
        For x = iStart To lEnd Step iStep
            Set rCells = Union(rCells, Rows(x).Resize(IIf(lEnd = UsedRange.Rows.Count, iRows, IIf(x + iRows - 1 < lEnd, iRows, lEnd - x + 1)), .Areas(2).Columns.Count))
        Next
        rCells.Select
        If MsgBox("Confirmez-vous la suppression de ces lignes ?", vbYesNo + vbDefaultButton2) = vbYes Then
            If .Areas(2).Columns.Count = Columns.Count Then
                rCells.Delete
            Else
                rCells.ClearContents
            End If
        End If
        [A1].Select
    End If
End With
'
End Sub

A+

Le 09/08/2018 à 19:44

Salut Eriiic, MFerrand,

et à tous les volontaires du forum...

autre idée à laquelle votre participation est souhaitée puisque challenge il y a (dixit MFerrand) et que, dans ce cas-ci, je n'aimerais pas trop jouer tout seul!

La même idée qu'Eriiic, càd, détection automatique d'une multi-sélection intégrant, bien sûr, une partie de fichier à conserver, mais qui permettrait plusieurs cas de figure (j'en ai déjà deux) :

  • lignes entières ;
  • lignes partielles, débutant en [A] ou plus loin ;
  • lignes partielles en escalier !!! Ex : [B3:H5] - [F8:H10] - ... ;
  • repérer "le choix de la conservation de fichier" ou pas en fonction des 2 premiers Areas pour permettre la simple sélection d'UNE cellule en 2e ou 3e sélection, histoire de permettre à l'utilisateur de se contenter de marquer le STEP entre blocs ;
  • intégrer le tout dans 'Sub Selection_Change' afin de permettre tout autre cas de sélection normale (If Not Intersect...)

Possible sans usine à gaz?

Qui, le premier... ?

Moi, je suis allumé sur ce coup!

C'est nouveau, c'est concept : c'est un Flash-Prog!

Le tout, bien sûr, sans qu'il faille s'appeler Amedeus pour l'utiliser..

A+, les cracks

Le 09/08/2018 à 19:59

Salut Maverick,

ça bout, ça bout...

Dans cette version-ci, tu peux sélectionner des colonnes "intérieures" à traiter.

C-à-d, par ex : [C3:E5] - [C7-E9] avec, toujours, obligation de sélectionner les deux mêmes blocs.

Puisqu'il ne s'agit pas de lignes complètes, le contenu est simplement effacé!

Les autres possibilités sont maintenues!

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
With Selection
    iOK = 0
    Select Case .Areas.Count
        Case 2
            If .Areas(1).Rows.Count = .Areas(2).Rows.Count Then iOK = 1
        Case 3
            If .Areas(2).Rows.Count = .Areas(3).Rows.Count Then iOK = 2
    End Select
    If iOK > 0 Then
        iStart = .Areas(iOK).Row
        iStep = .Areas(iOK + 1).Row - .Areas(iOK).Row
        iRows = .Areas(iOK).Rows.Count
        lEnd = IIf(iOK = 1, UsedRange.Rows.Count, .Areas(1).Row - 1)
        sCol = Split(Columns(.Areas(2).Column).Address(ColumnAbsolute:=False), ":")(1)
        Set rCells = Rows(UsedRange.Rows.Count + 1).EntireRow
        For x = iStart To lEnd Step iStep
            Set rCells = Union(rCells, Range(sCol & x).Resize(IIf(lEnd = UsedRange.Rows.Count, iRows, IIf(x + iRows - 1 < lEnd, iRows, lEnd - x + 1)), .Areas(2).Columns.Count))
        Next
        rCells.Select
        If MsgBox("Confirmez-vous la suppression de ces lignes ?", vbYesNo + vbDefaultButton2) = vbYes Then
            If .Areas(2).Columns.Count = Columns.Count Then
                rCells.Delete
            Else
                rCells.ClearContents
            End If
        End If
        [A1].Select
    End If
End With
'
End Sub

A+

Le 09/08/2018 à 21:09

Quasi trouvé!

Le 09/08/2018 à 21:54

Bonjour,

Heuuu, tu m'as semé dans les escaliers... Je n'ai pas repris toute ma forme d'avant.

moi j'attend excel 2039 pour intégrer ma prochaine fonctionnalité :

Sans le clavier ! Sans la souris ! tout par le contrôle de pensée

eric

Le 09/08/2018 à 22:16

Oooooh, Eriiic, noooon!

Ne me laisse pas!

C'est ton idée, après tout!

2039 ? Euh, à 80 balais, pas sûr d'être encore au rendez-vous des neurones!!!

Vive la life...

Le 10/08/2018 à 00:54

Bon, en l'état, hein!

00:42, c'est assez pour aujourd'hui!

Je crois que, sans "marqueur spécifique", ça va être dur de concilier les deux actions dans une même Sub Selection_Change...

  • si "pas de conservation", on peut ne sélectionner qu'une cellule du 2e bloc ;
  • si "conservation", on peut ne sélectionner qu'une cellule :
* pour marquer la première cellule à conserver ;

* pour marquer le 2e bloc.

- si "escalier', pareil, quel que soit le cas!

On verra plus clair demain!

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
With Selection
    iOK = 0
    Select Case .Areas.Count
        Case 2
            If .Areas(2).Row > .Areas(1).Row Then iOK = 1
        Case 3
            If .Areas(3).Row > .Areas(2).Row Then iOK = 2
    End Select
    If iOK > 0 Then
        iStart = .Areas(iOK).Row
        iStep = .Areas(iOK + 1).Row - .Areas(iOK).Row
        iRows = .Areas(iOK).Rows.Count
        lEnd = IIf(iOK = 1, UsedRange.Rows.Count, .Areas(1).Row - 1)
        sCol = Split(Columns(IIf(.Areas.Count = 2, .Areas(1).Column, .Areas(2).Column)).Address(ColumnAbsolute:=False), ":")(1)
        iStepCol = .Areas(iOK + 1).Column - .Areas(iOK).Column
        Set rCells = Rows(UsedRange.Rows.Count + 1).EntireRow
        For x = iStart To lEnd Step iStep
            Set rCells = Union(rCells, Range(sCol & x). _
                                        Offset(0, iIdx * iStepCol). _
                                        Resize(IIf(lEnd = UsedRange.Rows.Count, iRows, IIf(x + iRows - 1 < lEnd, iRows, lEnd - x + 1)), .Areas(2).Columns.Count))
            iIdx = iIdx + 1
        Next
        rCells.Select
        If MsgBox("Confirmez-vous " & IIf(.Areas(2).Columns.Count = Columns.Count, "l'élimination", "l'effacement du contenu") & " de ces lignes ?", vbYesNo + vbDefaultButton2) = vbYes Then
            If .Areas(2).Columns.Count = Columns.Count Then
                rCells.Delete
            Else
                rCells.ClearContents
            End If
        End If
        [A1].Select
    End If
End With
'
End Sub

A+

PS : allez voir mon post dans 'Discussions générales' !!!

Le 10/08/2018 à 11:27

Vous êtes vraiment incroyables !

tant de motivations pour aider le demandeur, améliorer son propre code et vous challenger entre vous, vous devez être passionnés par ce que vous faites!

Tant mieux je dois dire, je suis moins gêné de vous solliciter

Je test vos codes rapidement

Maverick'

Le 10/08/2018 à 12:34

Bonjour,

PS : allez voir mon post dans 'Discussions générales'

Je veux bien te croire qu'il est sympa à jouer, en tout cas il est beau et attirant. Bravo

Tu assures gite, couvert et soirée animée ?

Il y a quelques années j'avais fait la trans-bruxelloise, sympa mais fatigante à cause du froid.

Pas de conclusion hâtive s'il vous plait pour ceux qui auraient la curiosité de rechercher trans-bruxelloise sur google.

J'ai voulu voir pour me rappeler des souvenirs, j'ai été surpris

Il s'agit d'une rando de nuit à travers Bruxelles.

Le 10/08/2018 à 14:05
eriiic a écrit :

Pas de conclusion hâtive s'il vous plait pour ceux qui auraient la curiosité de rechercher trans-bruxelloise sur google.

Tu es majeur et vacciné, non ? Donc tu fais bien ce que tu veux...

Le 10/08/2018 à 20:23

Salut Maverick,

Salut l'équipe!

après plusieurs tests, j'ai repéré trois erreurs...

  • inutile : iOK = 0 ;
  • ajoutons ceci : Application.EnableEvents = False ;
  • corrigeons cela : Resize(IIf(x + iRows - 1 < lEnd, iRows, lEnd - x + 1), .Areas(2).Columns.Count)

... et ça va tout de suite beaucoup mieux! 

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
With Selection
    Select Case .Areas.Count
        Case 2
            If .Areas(2).Row > .Areas(1).Row Then iOK = 1
        Case 3
            If .Areas(3).Row > .Areas(2).Row Then iOK = 2
    End Select
    If iOK > 0 Then
        Application.EnableEvents = False
        iStart = .Areas(iOK).Row
        iStep = .Areas(iOK + 1).Row - .Areas(iOK).Row
        iRows = .Areas(iOK).Rows.Count
        lEnd = IIf(iOK = 1, UsedRange.Rows.Count, .Areas(1).Row - 1)
        sCol = Split(Columns(IIf(.Areas.Count = 2, .Areas(1).Column, .Areas(2).Column)).Address(ColumnAbsolute:=False), ":")(1)
        iStepCol = .Areas(iOK + 1).Column - .Areas(iOK).Column
        Set rCells = Rows(UsedRange.Rows.Count + 1).EntireRow
        For x = iStart To lEnd Step iStep
            Set rCells = Union(rCells, Range(sCol & x).Offset(0, iIdx * iStepCol). _
                            Resize(IIf(x + iRows - 1 < lEnd, iRows, lEnd - x + 1), .Areas(2).Columns.Count))
            iIdx = iIdx + 1
        Next
        rCells.Select
        If MsgBox("Confirmez-vous " & IIf(.Areas(2).Columns.Count = Columns.Count, "l'élimination", "l'effacement du contenu") & " de ces lignes ?", vbYesNo + vbDefaultButton2) = vbYes Then
            If .Areas(2).Columns.Count = Columns.Count Then
                rCells.Delete
            Else
                rCells.ClearContents
            End If
        End If
        [A1].Select
        Application.EnableEvents = True
    End If
End With
'
End Sub

A+

6deletewithstep.xlsm (19.19 Ko)
Le 10/08/2018 à 20:30

@Curulis: tu m'excuseras mais étant simultanément dans mes bagages et quelques autres opérations avant départ, c'est bien trop pour ma petite personne !

@+

Le 10/08/2018 à 20:36

Pas de souci, MFerrand!

J'étais aussi en plein délire excellien...

Bon voyage!

A+

Le 10/08/2018 à 20:48

bonjour

sans VBA, filtrez donc la colonne Final sur <>0

bien entendu, il faut refiltrer quand on modifie les paramètres

mais c'est avec les mains et sans VBA !

vive les comptables du Moyen-Âge qui ont inventé les colonnes de pointage

on fait des choses bien plus complexes avec ce principe basique

10classeur1.xlsx (24.81 Ko)
Le 10/08/2018 à 20:57

Salut jmd,

avant que je ne me casse la tête à essayer de comprendre, ce qui est loin d'être évident, ... es-tu sûr d'être sur le bon sujet?

a+

Le 11/08/2018 à 08:38

saltu Curulis57

- nombre de lignes à sélectionner

  • écart entre chaque sélection
  • ligne de la première selection

je sais, je n'ai pas paramétré le nombre total de lignes à sélectionner

mais comme la méthode des colonnes de pointage est facile, je ne doute pas qu'ajouter ce paramètre soit rapide (au besoin je le ferai).

on peut donc se passer de VBA

la méthode permet de bien décomposer les étapes

et elle est très visuelle

avec cette méthode, en axes x et y on peut aussi se passer de INDEX/EQUIV

bon, comment exploiter le résultat, eh bien tout dépend. On peut ne pas filtrer sur place, faire une extraction (par TCD ou Power Query, ou Power BI...)

le choix est vaste

rapide, simple, évolutif, fiable

compatible tous PC et Mac, tablettes et smartphones, et tous tableurs dont OpenOffice gratuit

Rechercher des sujets similaires à "macro selection ligne contrainte"