Doublons tableau
Bonjour à tous,
après plusieurs recherches je reste bloqué pour faire une macro. Etant débutant en VBA j'ai trouvé quelques sujets mais sans comprendre le fonctionnement des macros proposés.
J'ai un fichier qui génère des repas aléatoires sur une semaine (midi et soir). Le problème c'est qu'il ne prend pas en compte les doublons.
J'aimerais ajouter une étape qui détecte les doublons dans mon tableau et qui les remplaces par un autre repas.
Je met le code ici et le fichier en pièce jointe.
Merci d'avance pour votre aide :)
Sub Repas_Semaine()
Sheets("Repas semaine").Activate 'Va sur la feuille Repas semaine
Range("B2:C8").Select
Selection.ClearContents 'Supprimer le contenu de la cellule
'Selectionne la première cellule de la feuille Repas semaine
Sheets("Repas semaine").Activate
Range("B2").Select
'/// Boucle pour les 7 jours repas midi
Dim i As Integer
For i = 1 To 7
Sheets("Repas principal").Activate
'/// Sélection aléatoire d'une cellule de la ligne 2 à X = valeur de C1 et mise en forme
Dim AleaRow As Integer
Dim AleaCol As Integer
Randomize Timer
AleaRow = Int(Rnd() * Range("C1")) + 1 'Sélection dans les lignes
AleaCol = Int(Rnd() * 1) + 2 'Sélection dans la colonne
Cells(AleaRow, AleaCol).Select 'Sélectionne le croisement entre ligne et colonn
ActiveCell.Copy
Sheets("Repas semaine").Activate
ActiveCell.PasteSpecial Paste:=xlPasteValues
ActiveCell.Offset(1, 0).Select
Next
'/// Boucle pour les 7 jours repas soir
Range("C2").Select
For i = 1 To 7
Sheets("Repas principal").Activate
'Sélection aléatoire d'une cellule de la ligne 2 à 30
Randomize Timer
AleaRow = Int(Rnd() * Range("C1")) + 1 'Sélection dans les lignes
AleaCol = Int(Rnd() * 1) + 2 'Sélection dans la colonne
Cells(AleaRow, AleaCol).Select 'Sélectionne le croisement entre ligne et colonne
ActiveCell.Copy
Sheets("Repas semaine").Activate
ActiveCell.PasteSpecial Paste:=xlPasteValues
ActiveCell.Offset(1, 0).Select
Next
End SubSalut
essayer ça , lance le code avec le bouton "Repas semaine"
Sub test()
Dim drlg, tbl, Rpp, Rss
Set Rpp = Worksheets("Repas principal")
Set Rss = Worksheets("Repas semaine")
Range("B2:C8").ClearContents
drlg = Rpp.Cells(Rows.Count, "B").End(xlUp).Row
ReDim tbl(drlg - 2)
For i = 2 To drlg
tbl(i - 2) = Rpp.Cells(i, "B")
Next
cntr = drlg - 2
For j = 2 To 8 'nombre de jours x 2 (7x2 =14)
For m = 2 To 3
Randomize
p = Int((0 * Rnd) + cntr)
p = Int((cntr * Rnd) + 0)
Rss.Cells(j, m) = tbl(p)
If p <> cntr Then tbl(p) = tbl(cntr)
cntr = cntr - 1
Next
Next
End SubBonjour,
ça marche parfaitement :)
Je comprend pas vraiment la macro mais je vais étudier ça !
Merci beaucoup !!!