Attribution avec preferences (macro VBA) - (pour solution)

Le 05/05/2024 à 22:21

Bonjour à tous. ;);)

J'ai besoin de votre aide. Je souhaite attribuer des chambres à un groupe de personnes.

Les chambres sont renseignées dans la feuille "Chambres". Dans cette feuille, la colonne C permet de programmer la place des chambre entre 1, 2 et 3 personnes à prendre en compte dans l'attribution.

Il y a 4 plages de chambres selon les profils des personnes déterminés par le groupe et par le genre (F ou G).

L'attribution s'effectue dans la feuille "Attribution" de A3 à G69. La liste des personnes est présente dans la feuille "Attribution" de P3 à U69. La liste peut changer avec les données en conséquence (formations, groupes...).

Ainsi, les colonne A,B et C sont des données copiées de la feuille "Chambres", tandis que les colonnes D,E,F et G sont remplies par la copies des cellules respectives suivantes : P,R,Q et U (donc on retrouve en en D la valeur de P et en F la valeur de Q...).

En toute logique, une chambre est attribuable qu'une seule fois (à faire comprendre à excel).

Enfin, j'aimerais qu'il soit considéré des préférences qui sont inscrite dans la feuille "Preferences" avec des personnes à mettre ensemble si possible et à séparer obligatoirement (toutes les lignes ne concernent pas la présente attribution).

Vous me seriez d'une grande aide car je suis très limité et chat gpt n'y arrive pas et fait des erreurs qui se trouve dans la macro ci-après. En fonction de ce qui est souhaité, il faudrait la compléter :D

Je tente ma chance ici auprès de la communauté des pro.

MERCI D'AVANCE POUR LE TEMPS QUE VOUS Y CONSACREREZ.

Sub AttribuerChambres()

Dim wsAttribution As Worksheet
Dim wsChambres As Worksheet
Dim rngPersonnes As Range
Dim rngChambres As Range
Dim personne As Range
Dim ligne As Long
Dim chambreDisponible As Boolean
Dim cell As Range ' Déclaration de la variable cell

' Définir les feuilles de calcul

Set wsAttribution = ThisWorkbook.Sheets("Attribution")
Set wsChambres = ThisWorkbook.Sheets("Chambres")

' Définir la plage de données des personnes
Set rngPersonnes = wsAttribution.Range("P3:Z69")
' Parcourir chaque personne dans la plage de personnes
For Each personne In rngPersonnes.Rows
' Vérifier si la ligne est vide
If Application.CountA(personne) > 0 Then
' Réinitialiser le marqueur de chambre disponible

chambreDisponible = False

' Vérifier les valeurs en P et U pour définir la plage de chambres

If (personne.Cells(1, 16).Value = "Grp2!$A$8" Or personne.Cells(1, 16).Value = "Grp2!$A$9" Or personne.Cells(1, 16).Value = "Grp2!$A$10") And personne.Cells(1, 21).Value = "F" Then

Set rngChambres = wsChambres.Range("A3:A69")

ElseIf (personne.Cells(1, 16).Value = "Grp2!$A$8" Or personne.Cells(1, 16).Value = "Grp2!$A$9" Or personne.Cells(1, 16).Value = "Grp2!$A$10") And personne.Cells(1, 21).Value = "G" Then

Set rngChambres = wsChambres.Range("F3:F69")

ElseIf (personne.Cells(1, 16).Value = "Grp2!$A$3" Or personne.Cells(1, 16).Value = "Grp2!$A$4" Or personne.Cells(1, 16).Value = "Grp2!$A$5" Or personne.Cells(1, 16).Value = "Grp2!$A$6" Or personne.Cells(1, 16).Value = "Grp2!$A$7" Or personne.Cells(1, 16).Value = "Grp2!$A$11" Or personne.Cells(1, 16).Value = "Grp2!$A$12" Or personne.Cells(1, 16).Value = "Grp2!$A$13" Or personne.Cells(1, 16).Value = "Grp2!$A$14" Or personne.Cells(1, 16).Value = "Grp2!$A$15" Or personne.Cells(1, 16).Value = "Grp2!$A$16" Or personne.Cells(1, 16).Value = "Grp2!$A$17" Or personne.Cells(1, 16).Value = "Grp2!$A$18" Or personne.Cells(1, 16).Value = "Grp2!$A$19" Or personne.Cells(1, 16).Value = "Grp2!$A$20" Or personne.Cells(1, 16).Value = "Grp2!$A$21" Or personne.Cells(1, 16).Value = "Grp2!$A$22" Or personne.Cells(1, 16).Value = "Grp2!$A$23" Or personne.Cells(1, 16).Value = "Grp2!$A$24" Or personne.Cells(1, 16).Value = "Grp2!$A$25") And personne.Cells(1, 21).Value = "F" Then

Set rngChambres = wsChambres.Range("K3:K69")

ElseIf (personne.Cells(1, 16).Value = "Grp2!$A$3" Or personne.Cells(1, 16).Value = "Grp2!$A$4" Or personne.Cells(1, 16).Value = "Grp2!$A$5" Or personne.Cells(1, 16).Value = "Grp2!$A$6" Or personne.Cells(1, 16).Value = "Grp2!$A$7" Or personne.Cells(1, 16).Value = "Grp2!$A$11" Or personne.Cells(1, 16).Value = "Grp2!$A$12" Or personne.Cells(1, 16).Value = "Grp2!$A$13" Or personne.Cells(1, 16).Value = "Grp2!$A$14" Or personne.Cells(1, 16).Value = "Grp2!$A$15" Or personne.Cells(1, 16).Value = "Grp2!$A$16" Or personne.Cells(1, 16).Value = "Grp2!$A$17" Or personne.Cells(1, 16).Value = "Grp2!$A$18" Or personne.Cells(1, 16).Value = "Grp2!$A$19" Or personne.Cells(1, 16).Value = "Grp2!$A$20" Or personne.Cells(1, 16).Value = "Grp2!$A$21" Or personne.Cells(1, 16).Value = "Grp2!$A$22" Or personne.Cells(1, 16).Value = "Grp2!$A$23" Or personne.Cells(1, 16).Value = "Grp2!$A$24" Or personne.Cells(1, 16).Value = "Grp2!$A$25") And personne.Cells(1, 21).Value = "G" Then

Set rngChambres = wsChambres.Range("P3:P69")

End If

' Vérifier si rngChambres est défini et s'il contient des cellules

If Not rngChambres Is Nothing Then

If rngChambres.Cells.count > 0 Then

' Parcourir chaque cellule dans la plage de chambres

For Each cell In rngChambres

' Vérifier si la cellule contient une chambre disponible et non en travaux

If cell.Value <> "" And cell.Offset(0, 3).Value <> "en travaux" Then

' Vérifier si la chambre a des places disponibles

If cell.Offset(0, 2).Value <> "2 places seulement" Then

' Vérifier si la chambre n'a pas déjà été attribuée dans 3 lignes précédentes

ligne = personne.Row - 1

If Application.WorksheetFunction.CountIf(wsAttribution.Range("A3:A" & ligne), cell.Value) < 3 Then

' Attribuer les informations dans les colonnes A à G de la feuille "Attribution"

With wsAttribution
.Cells(personne.Row, 4).Value = cell.Value ' Numéro de chambre
.Cells(personne.Row, 2).Value = cell.Offset(0, 1).Value ' Bâtiment
.Cells(personne.Row, 3).Value = cell.Offset(0, 2).Value ' Copie de la donnée en B,G,L,Q selon les critères
.Cells(personne.Row, 1).Value = personne.Cells(1, 16).Value ' Donnée en P
.Cells(personne.Row, 5).Value = personne.Cells(1, 18).Value ' Donnée en R
.Cells(personne.Row, 6).Value = personne.Cells(1, 17).Value ' Donnée en Q
.Cells(personne.Row, 7).Value = personne.Cells(1, 21).Value ' Donnée en U
End With

' Marquer la chambre comme attribuée

chambreDisponible = True

' Sortir de la boucle car la chambre a été attribuée

Exit For
End If
End If
End If
Next cell

' Vérifier si aucune chambre n'a été attribuée

If Not chambreDisponible Then

' Afficher un message d'avertissement

MsgBox "Aucune chambre disponible correspondant aux critères pour la personne à la ligne " & personne.Row, vbExclamation, "Aucune chambre disponible"

End If

Else

MsgBox "La plage de chambres est vide.", vbCritical, "Erreur de plage de chambres"

End If

Else

MsgBox "La plage de chambres n'est pas définie.", vbCritical, "Erreur de plage de chambres"

End If

End If

Next personne

End Sub

Rechercher des sujets similaires à "attribution preferences macro vba solution"