XL 2010 Suppression aléatoire d'une cellule parmi d'autres (non vides) dans une plage "discontinue"

[Polo45]

Bonjour,

Je m'explique, je suis novice en VBA et j'aimerai savoir comment supprimer aléatoirement une cellule non vide parmi d'autres cellules non vides dans ma colonne, sachant que les cellules non vides de ma colonne ne sont pas forcement les unes en dessous des autres mais par petits paquets allant de 1 à plusieurs cellules.

J'ai dans un premier temps utilisé le code suivant pour sélectionner uniquement les cellules non vides de ma colonne :

Range("B14:B62").Cells.SpecialCells(xlCellTypeConstants).Select

Le code semble fonctionné.

Ensuite en regardant sur les forums je suis souvent tombé sur des exemples avec la fonction "random" comme ci-dessous :

Sub aleatoire()
Randomize
'Nombre aléatoire entier entre 1 et 50 :
nombre_aleatoire = Int(50 * Rnd) + 1
MsgBox nombre_aleatoire
End Sub

Donc voici ce que j'ai essayé de bricoler, ci-dessous mon programme ( avec une erreur '13' d'incompatibilité de type)

Mon fichier est aussi en pièce jointe.

Sub aleaB()

Dim nb2 As Integer
Dim plage As Range

Range("B14:B62").Select
nb2 = Range("B14:B62").Cells.SpecialCells(xlCellTypeConstants).Count
MsgBox "Nb de n° dans la colonne B : " & nb2

Do Until nb2 = 5
Range("B14:B62").Cells.SpecialCells(xlCellTypeConstants).Select
Set plage = Range("B14:B62").Cells.SpecialCells(xlCellTypeConstants)

Randomize
Cells(Int(Rnd * plage) + 1, 2).ClearContents

nb2 = nb2 - 1

Loop

End Sub


Avez-vous une solution à mon problème ?
En vous remerciant pas avance.

 

[mapomme]

Bonsoir @Polo45,

Une piste :

Sub AleaSuppr()
Const nbrsuppr = 5
Dim t, i&, n&, nfois&, k&, nbr&
  t = Range("B14:B62")
  For i = 1 To UBound(t)
    If t(i, 1) <> Empty Then
      n = n + 1
      t(n, 1) = Range("b14").Offset(i - 1).Address
    End If
  Next i
  Randomize
  For nfois = 1 To IIf(nbrsuppr > n, n, nbrsuppr)
    k = 1 + Int(n * Rnd)
    Range(t(k, 1)).ClearContents
    nbr = nbr + 1
    For i = k + 1 To n: t(i - 1, 1) = t(i, 1): Next i
    n = n - 1
    If n = 0 Then Exit For
  Next nfois
  MsgBox nbr & " articles supprimés"
End Sub

edit: v1b avec un message juste...

 

[Polo45]

Merci beaucoup !

Tout fonctionne !