1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80
| 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 |