Suppression aléatoire de lignes

[Troudz]

Bonjour,

J'ai un tableau mensuel contenant X centaines lignes. Je dois à chaque fois en contrôler 20% de la façon la plus aléatoire possible. Donc difficile de faire confiance à la main de l'homme pour cela. Je me suis dit que Vba devait pouvoir supprimer 80% des lignes pour ne garder que celles à contrôler mais j'ai beaucoup de mal à utiliser la fonction Rand. Sauriez vous me mettre sur la voie ?

Merci pour votre aide

 

[JNP]

Re : Suppression aléatoire de lignes

Bonjour Troudz 🙂,
A tester (attention, destructif 😱)

Sub test()
Dim Plage As Range, I As Integer, DerLigne As Integer
DerLigne = Range("A" & Rows.Count).End(xlUp).Row
I = Int(Rnd() * DerLigne + 1)
Set Plage = Range("A" & I)
While Plage.Count < Int(DerLigne / 10 * 8)
I = Int(Rnd() * DerLigne + 1)
Set Plage = Union(Plage, Range("A" & I))
Wend
Plage.EntireRow.Delete
End Sub

Bonne journée 😎

 

[Troudz]

Re : Suppression aléatoire de lignes

Testé et approuvé !!! Merci JNP !

Par contre j'ai du mal à comprendre où tu définies le pourcentage à garder (ou à éliminer). C'est avec l'expression :

Int(DerLigne / 10 * 8)

???

 

[Troudz]

Re : Suppression aléatoire de lignes

J'ai le droit à une question subsidiaire ? 🙄

J'ai placé cette macro dans un nouveau menu via une macro complémentaire. Etant donné que cette macro est destructrice, je voudrais être sûr que l'utilisateur ne la lance pas sur n'importe quelle fichier. Donc avant de lancer la suppression, je vérifie que la feuille active correspond bien au tableau habituel (en vérifiant les en - têtes de colonnes). J'ai donc fait cette petite procédure :

If Cells(1,1) <> "Nom" Or Cells(1,2) <> "Prénom" Or Cells(1,3) <> "Adresse" Or Cells(1,4) <> "Ville" .... Then
    Msgbox "Ce n'est pas le bon fichier"
    Exit sub
End If

Etant donné que j'ai une plus d'une quinzaine de colonnes, je trouve que ça fait vraiment pas propre de mettre autant de conditions dans mon "If". Est ce qu'il n'y aurait pas un autre moyen de procéder ?

 

[JNP]

Re : Suppression aléatoire de lignes

Re 🙂,
1) Oui, c'est bien cette ligne : si j'ai 1000 lignes, ça va me donner 800, donc en garder 200, la partie entière parce que les 10èmes de lignes, ça ne le fait pas trop sous Excel 😛...
On aurait pu partir sur une boucle de 1 à 800, MAIS, avec les aléatoires, il pourrait très bien sortir 20 fois la même ligne et ça ne correspondrait plus à 20%, d'où j'attends que la plage comprenne 800 lignes 🙄...
2) Le plus sûr, à mon avis, c'est de renommer non pas ton onglet, mais le nom interne de la feuille (accessible dans VBE, dans les propriétés de la feuille le champs (Name). Comme cela, ton utilisateur peux toujours renommer l'onglet, ça ne changera pas son nom interne, et tu peux faire le test sur ActiveSheet.CodeName = "Troudz" par exemple 😛...
Bon courage 😎

 

[Robert]

Re : Suppression aléatoire de lignes

Bonjour Trouz, JNP, bonjour le forum,

Puisque j'y ai planché dessus et malgré une solution déjà fournie, une autre proposition (non destructive mais colorative...) :

Option Explicit 'oblige à déclarer toutes les variablesSub Macro1()
Dim dl As Long 'déclare la variable dl (Dernière Ligne)
Dim tl() As Long 'déclare le tableau de variable tl (Tableau des Lignes)
Dim x As Long 'déclare la variable x (incrément)
Dim vpc As Long 'déclare la variable vpc (Vingt Pour Cent)
Dim tlv() As Long 'déclare le tableau de variable tlv (Tableau des Lignes à Vérifier)
Dim y As Long 'déclare la variable y (incrément)
Dim li As Long 'déclare la variable li (LIgne)
Dim z As Long 'déclare la variable z (incrément)


Rows.Interior.ColorIndex = xlNone 'supprime la couleur de toutes les lignes
dl = Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne dl de la colonne A (à adapter à ton cas)
ReDim tl(1 To dl) 'redimentionne le tableau tl
For x = 1 To dl 'boucle sur toutes les lignes
    tl(x) = x 'alimente le tableau tl
Next x 'prochaine ligne de la boucle
vpc = dl * 20 \ 100 'définit 20% du nombre de lignes
ReDim tlv(1 To vpc) 'redimentionne le tableau tlv
Randomize 'Initialise le générateur de nombres aléatoires
For x = 1 To vpc 'boucle 1 : sur les 20% de ligne
    li = Int(dl * Rnd + 1) 'définit la ligne li aléatroirement
    For y = LBound(tlv) To UBound(tlv) 'boucle 2 sur toutes les valeurs du tableau des lignes à vérifier tlv
        If li = tlv(y) Then x = x - 1: GoTo suite 'si la ligne li existe déjà, va à l'étiquette "suite" (sans ajouter la ligne li au tableau tlv)
    Next y 'prochaine valeur de la boucle 2
    tlv(x) = li 'ajoute la ligne li au tableau des lignes à vérifier
suite: 'étiquette
Next x 'prochaine ligne de la boucle 1
For x = LBound(tlv) To UBound(tlv) 'boucle sur toutes les lignes à vérifier du tableau tlv
    Rows(tlv(x)).Interior.ColorIndex = 3 'colore la ligne de rouge
Next x 'prochaine ligne de la boucle
'cette partie n'est pas nécéssaire elle permet de vérifier que bien 20% a été fait
For x = 1 To dl 'boucle sur toutes les lignes
    If Cells(x, 1).Interior.ColorIndex = 3 Then z = z + 1 'si la ligne est coloré de rouge, incrément z
Next x 'prochaine ligne de la boucle
MsgBox z & " / " & vpc 'message
End Sub

 

[Troudz]

Re : Suppression aléatoire de lignes

1) Ok, merci pour cet éclaircissement. Cela va mettre utile car, à terme, l'utilisateur devra pouvoir choisir le % de lignes qu'il veut traiter.

2) Je ne peux pas procéder comme ceci car le fichier à retraiter est généré tous les mois et adressé directement à l'utilisateur. Je ne pourrais donc pas intervenir sur le nom interne de la feuille. La seule sécurité envisageable (et suffisante) était de vérifier que les en - têtes de colonnes correspondait bien à la structure habituelle du fichier. J'avais (bêtement) espoir que Vba possède une fonction une peu plus simple que ce très long "If + 17 conditions"

 

[Troudz]

Re : Suppression aléatoire de lignes

Bonjour et merci Robert.
Effectivement, ça aurait été dommage de ne pas partager une solution aussi bien foutue (et commentée). Merci pour ton aide.

 

[JNP]

Re : Suppression aléatoire de lignes

Re 🙂,
Belle usine, Robert 😉...
Pour tes 17 tests, à adapter

If Join(Application.Transpose(Application.Transpose(Range("A1:D1"))), "") <> "NomPrénomAdresseVille" Then
    MsgBox "Ce n'est pas le bon fichier"
    Exit Sub
End If

Bonne suite 😎

 

[Troudz]

Re : Suppression aléatoire de lignes

Ah pas mal !
Je connaissais pas la fonction "Transpose". Effectivement, ça va me permettre d'avoir un code un peu plus lisible.

Merci à vous deux pour le coup de main et bonne journée

 

[Robert]

Re : Suppression aléatoire de lignes

Bonjour le fil, bonjour le forum,

Arfff JNP ! Au prix où est le gaz je risque de gagner des sous non ?

 

[ROGER2327]

Re : Suppression aléatoire de lignes

Bonjour à tous

Si x lignes veut dire beaucoup de lignes, et qu'on n'a pas l'après midi à perdre :

Pour colorier les x lignes :

Sub test3()
Dim i&, l&, b(), d As New Dictionary
    Randomize
    i = Cells(Rows.Count, 1).End(xlUp).Row
    l = (i * 2) \ 10    'Nb. de lignes à colorier
    Do While d.Count < l
        On Error Resume Next
        d.Add CStr(Int(1 + i * Rnd)), Int(1 + i * Rnd())
        On Error GoTo 0
    Loop
    b = d.Items
    Rows.Interior.ColorIndex = xlNone
    For i = 1 To UBound(b)
        Rows(b(i)).Interior.ColorIndex = 3
    Next
End Sub

(1,8 s pour 200000 lignes à traiter.)


Pour supprimer les x lignes :

Sub test2()
Dim i&, j&, k&, l&, c&, a(), b(), d As New Dictionary
    Randomize
    i = Cells(Rows.Count, 1).End(xlUp).Row
    l = (i * 2) \ 10    'Nb. de lignes à conserver
    c = 50              'Nb. de colonnes à conserver
    Do While d.Count < l
        On Error Resume Next
        d.Add CStr(Int(1 + i * Rnd)), Int(1 + i * Rnd())
        On Error GoTo 0
    Loop
    b = d.Items
ReDim a(l, 1 To c)
    For j = 0 To UBound(b)
        For k = 1 To c
            With Rows(b(j))
                a(j, k) = .Cells(1, k).Value
            End With
        Next
    Next
    With Application: .ScreenUpdating = 0: .Calculation = -4135: .EnableEvents = 0: End With
    Cells.ClearContents
    [A1].Resize(1 + UBound(a), UBound(a, 2)).Value = a
    With Application: .EnableEvents = 1: .Calculation = -4105: .ScreenUpdating = 1: End With
End Sub

(22 s pour 200000 lignes à traiter.)​

ROGER2327
#5491

Vendredi 20 Gueules 139 (Saint Lafleur, valet - fête Suprême Quarte)
25 Pluviôse An CCXX, 5,7623h - lièvre
2012-W07-2T13:49:47Z


Ajout : Le code ci-dessus est fautif. Voir le message #20.

 

[Troudz]

Re : Suppression aléatoire de lignes

Bonjour et merci Roger,

X voulait simplement dire "un nombre inconnu".
Mon fichier est différent à chaque période et je ne connais pas, à l'avance, le nombre de lignes qu'il contiendra. Mais en général, il y a entre 400 et 600 lignes.

Merci pour tes solutions que je vais analyser. J'avoue que pour l'instant, je patauge un peu pour comprendre vos trois propositions.

 

[Troudz]

Re : Suppression aléatoire de lignes

Re,

Je suis en train de tester la solution de Roger et ça ne veut pas marcher.

VBa bloque sur le

d As New Dictionary

J'ai bien essayé de le remplacer par

Set d = CreateObject("Scripting.Dictionary")

(et ça fonctionne) mais tout de suite après il bloque sur

d.Add CStr(Int(1 + i * Rnd)), Int(1 + i * Rnd())

en me disant que cette clé existe déjà.

J'ai pourtant fait un exact copier coller de ta proposition que tu sembles pourtant avoir testé.

Edit : en relisant le post je constate que l'erreur vient peut être de moi. J'ai oublié de préciser que j'étais sous Office xp. Sorry

 

[JNP]

Re : Suppression aléatoire de lignes

Re 🙂,
Dans VBA :
Outils -> Références cocher Microsoft Scripting Runtime 🙄
Bonne suite 😎