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 :)

12repas.xlsm (49.55 Ko)
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 Sub

Salut

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 Sub

Bonjour,

ça marche parfaitement :)

Je comprend pas vraiment la macro mais je vais étudier ça !

Merci beaucoup !!!

Rechercher des sujets similaires à "doublons tableau"