Microsoft 365 VBA remise a zero

jilooou à dit:

une synthèse de exercice réalisé par nom prénom

Cliquez pour agrandir...

Deadpool_CC à dit:

dans son fichier un tirage prend une valeur dans un colonne, l'affecte alea face à un nom dans une autre colonne et l'efface de la colonne d'origine ... donc c'est déjà sans remise en jeu de la valeur.
pour voir => dans son fichier clique plein de fois sur le gros bouton ... lol

Cliquez pour agrandir...

Deadpool_CC à dit:

Bonjour,

c'est vague comme demande ...
1) remise à zéro c'est quoi pour toi ... juste effacement de la colonne B ou il faut en plus reconstituer "PDU testé" d'origine ? ( un range("B2:b31").ClearContents + l'équivalent d'un "copier/coller" des valeurs originales "pdu testé" que tu auras ailleurs dans la feuille ou une autre feuille

2) je comprend pas ce que tu attends comme résultat po

Cliquez pour agrandir...

soan à dit:

Bonsoir jilooou, le fil,

ta sub Tirage() initiale comportait des erreurs, et j'ai préféré la réécrire entièrement ; j'en ai profité pour choisir une méthode plus efficace, selon laquelle c'est tout à fait inutile de modifier la colonne H : pas de suppressions, donc pas besoin de la réécrire pour une remise à zéro.

d'autre part, ceci est très important : tu es bien d'accord avec moi que ta sub Tirage() initiale mettait en colonne B, de façon aléatoire, les items de la colonne H lus successivement et dans cet ordre : H2 ; H3 ; H4 ; H5 ; H6 ; etc... or compare la longueur des 2 listes : en colonne H, de H2 à H42, il y a 41 items, de "STE-PDU-0001" à "STE-PDU-0041" ; en colonne B, de B2 à B31, il y a de la place pour 30 items ; conclusion : on va pouvoir écrire les 30 premiers items de la liste de la colonne H : "STE-PDU-0001" à "STE-PDU-0030" ; mais ensuite, c'est fini ! car y'a plus de place en colonne B pour y mettre les 11 derniers items de la colonne H : "STE-PDU-0031" à "STE-PDU-0041".
​

---

mode d'emploi : clique plusieurs fois sur le bouton "Tirage" ; tu peux aussi faire Ctrl t : c'est plus simple ! quand tout sera plein à gauche, fais encore une fois Ctrl t, et lis le message de la boîte de dialogue ; clique sur le bouton OK pour en sortir ; pour faire la remise à zéro (initialisation), fais Ctrl i ; lis le message de la boîte de dialogue, et clique sur OK ; tu peux voir que ça a remis comme c'était au début ➯ c'est prêt pour de nouveaux tirages : à toi de jouer de nouveau avec Ctrl t !

du fait qu'y'a pas assez d'place en colonne B pour les 11 derniers items de la colonne H, tu voudras peut-être allonger la liste des colonnes A:B ? ça ferait 11 lignes de plus ➯ ça irait jusqu'en ligne 42 ➯ même longueur que la colonne H ➯ y'aura la place d'écrire tous les items de la colonne H en colonne B ; mais peut-être que ton tirage au sort est du style : « seuls les 30 premiers participants au jeu auront le droit de recevoir un cadeau, Maître Huissier Jilooou ayant été mandaté pour contrôler le bon déroulement du tirage au sort » ? remarque : les salariés de l'entreprise n'ont pas le droit de participer au jeu, car c'est réservé pour le public ! ​

si besoin, tu peux demander une adaptation ; à te lire pour avoir ton avis.

​

---

code VBA de ThisWorkbook (3 lignes) :

VB:

Private Sub Workbook_Open()
  T(2) = 255: TblInit
End Sub

code VBA de Module1 (30 lignes) :

VB:

Option Explicit

Public T(2 To 31) As Byte, j As Byte

Sub TblInit()
  If T(2) < 255 Then
    Feuil1.CommandButton_tirage.Caption = "Tirage"
    MsgBox "Initialisation des tirages", 64, "Remise à Zéro"
  End If
  Dim i As Byte: [B2:B31].ClearContents: Randomize
  For i = 2 To 31: T(i) = i: Next i: j = 1
End Sub

Sub Tirage()
  Dim n As Byte, i As Byte
  Do
    For i = 2 To 31
      If T(i) > 0 Then n = 1: Exit For
    Next i
    If n = 0 Then _
      MsgBox "La plage verte des résultats est pleine.", _
      64, "Terminé !": GoTo Fin
    n = Int(30 * Rnd) + 2: If T(n) > 0 Then T(n) = 0: Exit Do
  Loop
  Feuil1.CommandButton_tirage.Caption = Cells(n, 1)
  j = j + 1: Cells(n, 2) = Cells(j, 8)
Fin:
  ActiveCell.Select 'désélectionne le bouton
End Sub

soan

Cliquez pour agrandir...