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 :
Donc pour supprimer aléatoirement des lignes dans un tableau, il faut suffit de faire :
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 !
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 SubDonc 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 "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:
,
