Boite à outils de GéoTrouvePas : Suppression aléatoire de lignes

GeoTrouvePas

XLDnaute Impliqué
Bonjour les XLDiens !

Mon collègue Troudz a lancé une conversation hier car il n'arrivait pas à faire une procédure permettant de supprimer des lignes dans un tableau de façon aléatoire. Ce problème a été solutionné grâce à l'intervention de JNP, Robert et Roger2327.

M'étant déjà posé la question mais n'ayant jamais eu le temps de pondre quelque chose de correct, j'ai profité de son message pour m'y remettre et écrire une procédure à glisser dans ma boîte à outils. C'est cette procédure que je viens partager aujourd'hui avec vous aujourd'hui :
Code:
Sub PlageAleatoire(Plage As Range, PrctSave As Byte, Entete As Boolean)

    'Solution initialement proposée par Roger2327 du forum ExcelDownloads : http://www.excel-downloads.com/forum/178549-suppression-aleatoire-de-lignes.html#post1098473

    Dim NbLigne As Long
    Dim i As Long
    Dim j As Long
    Dim LigneSave As Long
    Dim ColonneSave As Long
    Dim TdbDef()
    Dim TdbProvis()
    Dim MemoScreenUpdating As Boolean
    Dim MemoCalculation As Integer
    Dim MemeEnableEvents As Boolean
    Dim Mondico As New Dictionary
    
    Randomize
    
    'Si la plage contient des en - têtes, on décalle d'un ligne vers le bas
    If Entete = True Then Set Plage = Plage.Offset(1, 0).Resize(Plage.Rows.Count - 1, Plage.Columns.Count)

    Plage.Select
    'Nombre de lignes de la plage
    NbLigne = Plage.Rows.Count
    'Nombre de lignes à conserver
    LigneSave = NbLigne * PrctSave / 100
    'Nombre de colonnes à conserver
    ColonneSave = Plage.Columns.Count
   
    'On détermine de façon aléatoire les numéros des lignes qui seront conservées
    Do While Mondico.Count < LigneSave
        On Error Resume Next
        Mondico.Add CStr(Int(1 + NbLigne * Rnd)), Int(1 + NbLigne * Rnd())
        On Error GoTo 0
    Loop
    
    'On transfère le dico dans une variable tableau provisoire
    TdbProvis = Mondico.Items

    'On tri la variable tableau provisoire et on ne transfert dans la variable tableau définitive que les lignes à garder
    ReDim TdbDef(LigneSave, 1 To ColonneSave)
    For i = 0 To UBound(TdbProvis)
        For j = 1 To ColonneSave
            With Plage.Rows(TdbProvis(i))
                TdbDef(i, j) = .Cells(1, j).Value
            End With
        Next
    Next
    
    'On mémorise l'état du ScreenUpdating, Calculation et EnableEvents et on désactive tout
    With Application
        MemoScreenUpdating = .ScreenUpdating
        .ScreenUpdating = False
        MemoCalculation = .Calculation
        .Calculation = -4135
        MemeEnableEvents = .EnableEvents
        .EnableEvents = False
    End With
    
    'On transfert la plage retraitée depuis la variable tableau définitive
    Plage.Cells.Clear
    Plage.Resize(1 + UBound(TdbDef), UBound(TdbDef, 2)).Value = TdbDef
    
    'On redonner leur valeur initiale au ScreenUpdating, Calculation et EnableEvents
    With Application
        .ScreenUpdating = MemoScreenUpdating
        .Calculation = MemoCalculation
        .EnableEvents = MemeEnableEvents
    End With

End Sub

Donc pour supprimer aléatoirement des lignes dans un tableau, il faut suffit de faire :
Code:
Call PlageAleatoire(ThisWorkbook.Sheets("Feuil1").Range("zzz"), 20, True)
L'argument "Plage" correspond à la plage à traiter.
L'argument "PrctSave" correspond au pourcentage de lignes à garder.
L'argument 'Entete' précise si la plage sélectionnée contient des en - têtes de colonne.

A noter que 99.99% de cette solution est inspirée de la procédure de Roger2327. Je n'ai fait que rajouter la gestion de ces 3 arguments.

Voilà j'espère simplement que ça pourra vous être utile un jour.

Bonne fin de journée à tout le monde !
 
Dernière édition:

GeoTrouvePas

XLDnaute Impliqué
Re : Boite à outils de GéoTrouvePas : Suppression aléatoire de lignes

Bonjour Roger,

Arf j'avais pas pensé à mettre le lien vers le sujet initial. En tout cas ton code est d'une redoutable rapidité. J'espères que tu n'es pas vexé que je l'ai repris ? Je trouvais ça dommage de ne pas mettre à disposition des XLDiens ce code en version "prêt à l'emploi".
 
G

Guest

Guest
Re : Boite à outils de GéoTrouvePas : Suppression aléatoire de lignes

bonsoir,

Oui, mettre les références de ses sources est une bonne chose. Ce serait bien de faire apparaître le lien en commentaire de maco.

A+
 

GeoTrouvePas

XLDnaute Impliqué
Re : Boite à outils de GéoTrouvePas : Suppression aléatoire de lignes

Bonsoir Hasco,

J'ai essayé de penser à tout du premier coup mais c'était loin d'être parfait (C'est ma première publication de ce genre alors je fais ce que je peux)
Je viens de rajouter les sources et le lien en commentaire.

Merci pour ta remarque.

Bonne soirée.
 

ROGER2327

XLDnaute Barbatruc
Re : Boite à outils de GéoTrouvePas : Suppression aléatoire de lignes

Bonjour à tous



Pas d'emballement ! Aucun souci pour moi avec les citations : si j'ai rappelé le lien de ma contribution originale, c'est uniquement pour faciliter la navigation. D'autant que le code auquel je renvoie ne fonctionne pas correctement à cause d'une grossière erreur de débutant que personne n'a relevée. (Ce qui prouve au passage que les réponses ne sont même pas essayées par les demandeurs. Sont-elles seulement lues ?)

D'autre part, il s'agissait d'une demande particulière visant à conserver 20% des données. La réponse était donnée en conséquence. De là à en extrapoler une procédure générale pour extraire de 0% à 100%, c'est une autre affaire. En effet, le recours à la procédure utilisant un objet "dictionnaire" de VBScript peut se justifier pour un taux de conservation de 20%, mais les performances se dégradent si le taux de conservation s'approche de 100%. Autre remarque à propos du taux de conservation : pourquoi devrait-il évoluer par point entier de pourcentage ? Si l'on veut extraire 20 lignes de 200000, ce taux doit être 0,01%.
Une autre encore : pour quelle raison la procédure ne pourrait opérer que sur la feuille active, ce qu'implique la ligne Plage.Select ?
Bref, il y a du pain sur la planche... J'y travaille et j'essaierai de donner une version plus consistante de ma procédure dans les heures qui viennent.

En attendant, bravo à GéoTrouvePas pour s'être lancé dans l'aventure.​


ROGER2327
#5506


Dimanche 22 Gueules 139 (Saint Sexe, Stylite - fête Suprême Première seconde)
27 Pluviôse An CCXX, 5,5542h - noisetier
2012-W07-4T13:19:48Z
 

JNP

XLDnaute Barbatruc
Re : Boite à outils de GéoTrouvePas : Suppression aléatoire de lignes

Bonjour le fil :),
D'autant que le code auquel je renvoie ne fonctionne pas correctement à cause d'une grossière erreur de débutant que personne n'a relevée.
Je l'ai pourtant testée et n'ai pas vu de grosse erreur (c'est vrai que j'ai surtout testé le temps, je n'ai pas contrôlé l'exactitude de ce qui restait :rolleyes:) :eek:...
Bonne suite :cool:
Ajout : Grossière de débutant, vous exagérez :p... Effectivement, il vaut mieux que l'aléatoire soit le même dans les 2 parties du Dico, mais il fallait le voir :rolleyes:...
 
Dernière édition:

ROGER2327

XLDnaute Barbatruc
Re : Boite à outils de GéoTrouvePas : Suppression aléatoire de lignes

Bonjour Jnp



Bonjour le fil :),Je l'ai pourtant testée et n'ai pas vu de grosse erreur (c'est vrai que j'ai surtout testé le temps, je n'ai pas contrôlé l'exactitude de ce qui restait :rolleyes:) :eek:...
Bonne suite :cool:
Au temps pour moi ! J'ai oublié de dire ce qu'est cette erreur : voir https://www.excel-downloads.com/threads/suppression-aleatoire-de-lignes.178549/.

Aller trop vite fait perdre du temps.


ROGER2327
#5508


Dimanche 22 Gueules 139 (Saint Sexe, Stylite - fête Suprême Première seconde)
27 Pluviôse An CCXX, 5,7783h - noisetier
2012-W07-4T13:52:04Z
 

ROGER2327

XLDnaute Barbatruc
Re : Boite à outils de GéoTrouvePas : Suppression aléatoire de lignes

Suite...


Une nouvelle proposition (plus sûre et plus rapide ?) :
VB:
Sub PlageAleatoire3(Plage As Range, TauxDeSélection#, Entête As Boolean)

Dim i&, j&, tmp&, alea!                     'Variables de service.
Dim NbColonnes&                             'Nombre de colonnes à conserver.
Dim NbLignes&                               'Nombre de lignes de la plage Plage.
Dim NbLignesConservées&                     'Nombre de lignes à conserver.
Dim PlageConservée()                        'Tableau des cellules conservées.
Dim ListeDeSélectionItems()                 'Tableau des numéros de lignes dans la plage Plage.

Dim RafraichissementAffichage As Boolean    'Etat courant du rafraichissement de l'affichage.
Dim ModeCalcul%                             'Mode courant de calcul.
Dim GestionEvènement As Boolean             'Etat courant de la gestion des évènements.

    Randomize

'Si la plage de données contient une ligne d'entêtes, on élimine la première ligne de données du traitement.
    If Entête Then Set Plage = Plage.Offset(1, 0).Resize(Plage.Rows.Count - 1, Plage.Columns.Count)

    NbLignes = Plage.Rows.Count
    tmp = NbLignes * TauxDeSélection \ 100
    NbLignesConservées = IIf(tmp > NbLignes, NbLignes, IIf(tmp <= 0, 0, tmp))
    NbColonnes = Plage.Columns.Count

    ReDim ListeDeSélectionItems(1 To NbLignes)
    For i = 1 To NbLignes: ListeDeSélectionItems(i) = i: Next

    ReDim PlageConservée(1 To NbLignesConservées - (NbLignesConservées = 0), 1 To NbColonnes)
    For i = 1 To NbLignesConservées         'Placement aléatoire des lignes à conserver dans le tableau PlageConservée.
        tmp = ListeDeSélectionItems(i)
        alea = Int(i + (NbLignes - i + 1) * Rnd)
        ListeDeSélectionItems(i) = ListeDeSélectionItems(alea): ListeDeSélectionItems(alea) = tmp
        With Plage.Rows(ListeDeSélectionItems(i))
            For j = 1 To NbColonnes: PlageConservée(i, j) = .Cells(1, j).Value: Next
        End With
    Next

    With Application                        'Ce bloc et la dernière ligne, supposés favoriser la vitesse d'exécution, sont facultatifs.
        RafraichissementAffichage = .ScreenUpdating: .ScreenUpdating = False
        ModeCalcul = .Calculation: .Calculation = -4135
        GestionEvènement = .EnableEvents: .EnableEvents = False
    End With

'Effacement des données pour les remplacer par les seules lignes conservées.
    Plage.Cells.Clear
    If NbLignesConservées Then Plage.Resize(NbLignesConservées, NbColonnes).Value = PlageConservée

    With Application: .EnableEvents = GestionEvènement: .Calculation = ModeCalcul: .ScreenUpdating = RafraichissementAffichage: End With

End Sub
Mode d'emploi identique à celui de la procédure de GeoTrouvePas.

Que les testeu(r)(se)s ne se gênent pas !​


ROGER2327
#5514


Dimanche 22 Gueules 139 (Saint Sexe, Stylite - fête Suprême Première seconde)
27 Pluviôse An CCXX, 6,3808h - noisetier
2012-W07-4T15:18:50Z
 

david84

XLDnaute Barbatruc
Re : Boite à outils de GéoTrouvePas : Suppression aléatoire de lignes

Bonjour tout le monde,
Que les testeu(r)(se)s ne se gênent pas !
Je suis d'accord avec vous Roger face au manque de tests effectués par les demandeurs et autre personnes qui suivent une discussion. C'est pourtant un bon moyen de participer même si l'on ne se sent pas "au niveau" pour proposer des solutions.
Je n'ai pas suivi la discussion et prends donc le train en marche.

Test effectué sur un tableau de 10 lignes + entête :
Le test
Sub test()
Call PlageAleatoire(ThisWorkbook.Sheets("Feuil1").Range("A1:E11"), 5, True)
End Sub

Dans cette configuration, toute valeur de l'argument "TauxDeSélection" inférieur à 10 ramène un tableau vide (donc aucune ligne sélectionnée de manière aléatoire).
Le traitement n'est pas en cause car le résultat est logique mais est-ce le résultat recherché ?
Autrement dit, doit-on considérer qu'aucune ligne ne peut être sélectionnée ou doit-on prévoir qu'il y ait toujours au minimum une ligne sélectionnée ?
Comme je ne sais pas quel est au final le but recherché, je préfère simplement vous signaler ce cas de figure.

Autre cas de figure : lorsque la plage sélectionnée est plus grande que le tableau (de 1 ligne par ex), la sélection peut ramener une ligne vide (ou plusieurs si plusieurs lignes vides dans la plage sélectionnée). Là encore, si c'est le but recherché, rien à redire mais je préfère vous signaler ce cas de figure.
A+
 

ROGER2327

XLDnaute Barbatruc
Re : Boite à outils de GéoTrouvePas : Suppression aléatoire de lignes

Bonsoir à tous, bonsoir david84


Merci pour le suivi de la discussion. Les deux questions que vous soulevez ont la même réponse : oui, les résultats obtenus sont conformes à ce que je souhaitais obtenir. Dans le cadre de la problématique initiale, il s'agissait de sélectionner aléatoirement 20% des lignes d'une plage donnée, sans qu'aucune autre condition soit posée.
J'ai essayé d'y répondre aussi strictement que je le pouvais.
Si on pose le problème sous la forme "tirer aléatoirement x% des lignes, en en conservant toutefois au moins une", il faudra modifier
Code:
NbLignesConservées = IIf(tmp > NbLignes, NbLignes, IIf(tmp <= 0, 0, tmp))
en
Code:
NbLignesConservées = IIf(tmp > NbLignes, NbLignes, IIf(tmp <= 0, 1, tmp))
Pour l'autre point, les modifications seront sans doutes plus délicates. Il faudrait un cahier des charges très précis, indiquant par exemple qu'il faut éliminer les lignes entièrement vides, ou les lignes dont telle ou telle cellule est vide, etc.

En fait, ce code n'est pour moi un exercice ou j'ai cherché 1) à respecter la demande sans interprétation, 2) à obtenir quelque chose susceptible de traiter au moins 100000 lignes dans un délai raisonnable.

Voilà tout.


Bonne soirée.


ROGER2327
#5515


Dimanche 22 Gueules 139 (Saint Sexe, Stylite - fête Suprême Première seconde)
27 Pluviôse An CCXX, 8,7446h - noisetier
2012-W07-4T20:59:14Z
 
Dernière édition:

Discussions similaires

Réponses
4
Affichages
390
Réponses
4
Affichages
394

Statistiques des forums

Discussions
314 422
Messages
2 109 447
Membres
110 482
dernier inscrit
ilyxxxh