IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

boucle While wend [XL-2013]


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre éclairé
    Homme Profil pro
    Administrateur de base de données
    Inscrit en
    Janvier 2017
    Messages
    556
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 43
    Localisation : Canada

    Informations professionnelles :
    Activité : Administrateur de base de données
    Secteur : Santé

    Informations forums :
    Inscription : Janvier 2017
    Messages : 556
    Par défaut boucle While wend
    Bonjour a vous,



    J'ai besoin de votre aide. Étant donné que je c'Est la première fois que j'utilise cette boucle logique et lu a cette effet sur différent site et que j'ai toujours un problème, je solicite votre aide.


    J'ai une feuille ayant des données dans les colonnes A, B, C et D. Je voudrais épuré ma feuille des items ayant l'expression "Item retiré" dans la colonne B. Par épuré, je voudrais détruire la ligne entière afin d'enlever ces lignes non pertiente de ma feuille.


    Donc la logique est tant aussi longtemps que je trouve des "Item retiré" dans la colonne B, je détruis les ligne en question et j'arrete lorsque j'en ai plus.


    J,arrive donc avec une boucle While wend

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    Dim item_retire As Range
    Set item_retire = Sheets("filtre").Range("b2:b" & LastLignUsedInSheet("filtre")).Find("Item retiré", LookAt:=xlWhole)
     
    While item_retire = "Item retiré"
     
    item_retire.EntireRow.Delete
     
    Wend
    Dont la fonction

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    Public Function LastLignUsedInSheet(NomOnglet As String)
     
        LastLignUsedInSheet = Worksheets(NomOnglet).UsedRange.Rows.Count
     
    End Function

    ESt-ce que vous pouvez m'orrienter dans la bonne situation ???



    en vous remerciant d'avance

  2. #2
    Membre éclairé
    Homme Profil pro
    Administrateur de base de données
    Inscrit en
    Janvier 2017
    Messages
    556
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 43
    Localisation : Canada

    Informations professionnelles :
    Activité : Administrateur de base de données
    Secteur : Santé

    Informations forums :
    Inscription : Janvier 2017
    Messages : 556
    Par défaut
    J,arrive également avec cette logique avec un erreur



    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    Set item_retire = Sheets("filtre").Range("b2:b" & LastLignUsedInSheet("filtre"))
     
     
    While item_retire.Find("Item retiré", LookAt:=xlWhole) = "Item retiré"
     
    item_retire.Find("Item retiré", LookAt:=xlWhole).EntireRow.Delete
     
    Wend


    Cette logique semble fonctionné mais lorsque la boucle ne trouve plus rien, c'est la que j'ai l'erreur ....

  3. #3
    Expert confirmé
    Homme Profil pro
    Inscrit en
    Août 2010
    Messages
    3 453
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations forums :
    Inscription : Août 2010
    Messages : 3 453
    Par défaut
    Bonjour,

    Puisque tu utilises un filtrage, je suis resté sur le concept (normalement on utilise une boucle en partant de la fin pour faire des suppressions).
    Dans ton classeur, une feuille sera ajoutée pour recevoir momentanément les valeurs à garder puis sera supprimée en fin de procédure :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
     
    Sub Test()
     
        Dim Fe As Worksheet
        Dim Plage As Range
     
        'gèle le rafraîchissement de l'écran
        Application.ScreenUpdating = False
     
        'défini la plage sur toute la feuille
        Set Plage = DefPlage(Worksheets("filtre"))
     
        'filtre pour ne garder que les lignes n'ayant pas "Item retiré"
        Plage.AutoFilter 2, "<>Item retiré"
     
        'ajoute une nouvelle feuille
        Set Fe = Worksheets.Add
     
        'copie sur la feuille "Feuil2" le résultat du filtrage (cette feuille doit impérativement exister dans le classeur !)
        Worksheets("filtre").AutoFilter.Range.EntireRow.Copy Fe.Cells(1, 1)
     
        'suppression du filtre
        Plage.AutoFilter
     
        'vide la feuille...
        Worksheets("filtre").Cells.Clear
     
        'récupère les valeurs sur la feuille "Feuil2"...
        Set Plage = DefPlage(Fe)
     
        'les colle à nouveau sur la feuille "filtre"
        Plage.Copy Worksheets("filtre").Cells(1, 1)
     
        Application.DisplayAlerts = False
        'supprime la feuille
        Fe.Delete
     
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
     
    End Sub
     
    Function DefPlage(Fe As Worksheet, Optional L As Long = 1, Optional C As Long = 1) As Range
     
        On Error GoTo Fin
     
        With Fe
     
            Set DefPlage = .Range(.Cells(L, C), _
                           .Cells(.Cells.Find("*", .[A1], -4123, , _
                           1, 2).Row, .Cells.Find("*", .[A1], -4123, , _
                           2, 2).Column))
     
        End With
     
        Exit Function
     
    Fin:
     
        Set DefPlage = Nothing
     
    End Function

  4. #4
    Membre éclairé
    Homme Profil pro
    Administrateur de base de données
    Inscrit en
    Janvier 2017
    Messages
    556
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 43
    Localisation : Canada

    Informations professionnelles :
    Activité : Administrateur de base de données
    Secteur : Santé

    Informations forums :
    Inscription : Janvier 2017
    Messages : 556
    Par défaut
    Bonjour Theze


    Un gros merci !!!



    J'ai ajouté à la fin

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    'détruire la feuille ajoutée
        Fe.Delete
    et tout marche a merveille !!!

  5. #5
    Expert confirmé
    Homme Profil pro
    Inscrit en
    Août 2010
    Messages
    3 453
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations forums :
    Inscription : Août 2010
    Messages : 3 453
    Par défaut
    Bonjour,

    J'ai ajouté à la fin
    mais l'instruction y est déjà dans mon code !
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
     
        'supprime la feuille
        Fe.Delete

  6. #6
    Membre éclairé
    Homme Profil pro
    Administrateur de base de données
    Inscrit en
    Janvier 2017
    Messages
    556
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 43
    Localisation : Canada

    Informations professionnelles :
    Activité : Administrateur de base de données
    Secteur : Santé

    Informations forums :
    Inscription : Janvier 2017
    Messages : 556
    Par défaut
    oups, oui je viens voir ...


    J,avais déjà enlever préalablement dans mon code les

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
      Application.ScreenUpdating = True
        Application.DisplayAlerts = True
    J'ai donc omis la ligne de destruction de la feuille.


    Donc tu es encore plus génial !!!!

    merci encore une fois cher ami pour ton aide !!!!

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [AC-2000] Sortir d'une boucle while wend
    Par 973thom dans le forum VBA Access
    Réponses: 2
    Dernier message: 03/09/2009, 10h14
  2. chargement du Combo Par sql boucle While wend
    Par r.mehdi dans le forum VB 6 et antérieur
    Réponses: 1
    Dernier message: 09/06/2008, 18h16
  3. Boucle While .. Wend
    Par petibonohm dans le forum Macros et VBA Excel
    Réponses: 9
    Dernier message: 21/02/2008, 16h19
  4. [VBA]Boucle While/Wend interrompue
    Par stéphane_ais2 dans le forum VBA Access
    Réponses: 6
    Dernier message: 29/03/2007, 15h05
  5. Recordset et boucle While...Wend
    Par sbeprod dans le forum Access
    Réponses: 9
    Dernier message: 24/07/2006, 16h48

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo