Discussion :

[cabu37]

Bonjour!

J'ai un petit problème qui me prend la tête et qui ne doit pas être si dur que ça à résoudre…

Mon problème est que les plages sont variables dans d’onglets variables. Alors je m’explique :
L'objectif est de connaître la disponibilité d'un matériel potentiellement utilisé dans 3 salles (3 onglets).
Dans chacune des salles le matériel peut être indisponible suite à une intervention (I).
Cette disponibilité doit être renseignée par demi-journée (J : Jour et N : Nuit) et ne tient pas compte des commentaires (Comm)
L'onglet REC récapitule la disponibilité des matériels par demi journée sur la semaine.

J’ai réussi à faire tout le code mais, je n’arrive pas à changer de colonne. Je joins un fichier exemple pour que ce soit plus clair !
Essai macro.xlsm

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Dim L As Integer 'Max lignes onglets
Dim j As Integer 'Lignes
Dim k As Integer 'Colonnes de l'onglet "REC"
Dim m As Integer 'Colonnes des salles
 
L = Application.WorksheetFunction.Max(Sheets("Salle1").UsedRange.Rows.Count, Sheets("Salle2").UsedRange.Rows.Count, _
Sheets("Salle3").UsedRange.Rows.Count)
k = 2
m = 2
While k < Sheets("REC").UsedRange.Columns.Count + 1
j = 3
While j < Sheets("REC").UsedRange.Rows.Count + 1
If (Application.WorksheetFunction.CountIfs(Sheets("Salle1").Range("A3:A" & L), Sheets("REC").Range("A" & j), Sheets("Salle1").Range(Cells(3, m), Cells(L, m)), "I") Or _
    Application.WorksheetFunction.CountIfs(Sheets("Salle2").Range("A3:A" & L), Sheets("REC").Range("A" & j), Sheets("Salle2").Range(Cells(3, m), Cells(L, m)), "I") Or _
    Application.WorksheetFunction.CountIfs(Sheets("Salle3").Range("A3:A" & L), Sheets("REC").Range("A" & j), Sheets("Salle3").Range(Cells(3, m), Cells(L, m)), "I")) Then
    Sheets("REC").Cells(j, k) = "I"
    Else
    Sheets("REC").Cells(j, k) = "Ok"
End If
j = j + 1
Wend
k = k + 1
m = m + 2
Wend

[Invité]

J'ai un petit problème qui me prend la tête et qui ne doit pas être si dur que ça à résoudre…

Bonsoir,

Une solution possible dans le code joint :

Celui-ci est composé de deux sub

- MajDisponibiliteDuMateriel : Programme principal remplissant le tableau de l'onglet REC
- ChercherLeMaterielPourLaSalle : Identifiant l'occupation de chaque matériel pour le jour et la salle choisie.

et d'une fonction
- ChercherLeJourDeLaSalle : Recherchant la colonne dans les tableaux des salles pour le jour choisi

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
 
Option Explicit
 
 
Public ValeurJ As String
Public ValeurN As String
Public SallesDuMaterielJ As String
Public SallesDuMaterielN As String
Public AnomalieDispoJ As Integer
Public AnomalieDispoN As Integer
 
Sub MajDisponibiliteDuMateriel()
 
Dim SalleREC As Worksheet
Dim AireMaterielREC As Range
Dim CelluleMaterielREC As Range
Dim DerniereLigneREC As Long
Dim DerniereColonneREC As Long
 
Dim J As Long
Dim ColonneTrouvee As Long
Dim NumeroSalle As Integer
 
Dim JourATrouver As String
 
Dim ListeDesSalles As Variant
 
 
    ListeDesSalles = Array("Salle1", "Salle2", "Salle3")
 
    Set SalleREC = Sheets("REC")
    With SalleREC
 
         DerniereLigneREC = .Cells(.Rows.Count, 1).End(xlUp).Row
         DerniereColonneREC = .Cells(2, .Columns.Count).End(xlToLeft).Column
         Set AireMaterielREC = .Range(.Cells(3, 1), .Cells(DerniereLigneREC, 1))
 
 
         For Each CelluleMaterielREC In AireMaterielREC
 
             ' La valeur est Ok pour chaque matériel dans l'onglet REC
             With .Range(CelluleMaterielREC.Offset(0, 1), CelluleMaterielREC.Offset(0, DerniereColonneREC - 1))
                   .Value = "Ok"
                   If Not .Comment Is Nothing Then .Comment.Delete
             End With
 
             For J = 2 To DerniereColonneREC Step 2
 
                 SallesDuMaterielJ = ""
                 SallesDuMaterielN = ""
                 AnomalieDispoJ = 0
                 AnomalieDispoN = 0
 
                 ' Recherche du jour de la semaine dans l'onglet REC
                 JourATrouver = CelluleMaterielREC.Offset(1 - CelluleMaterielREC.Row, J - 1).MergeArea.Cells(1, 1).Value
 
                 ' Balayage des salles
                 For NumeroSalle = 0 To 2
                     ' Recherche du jour choisi dans chaque salle
                     ColonneTrouvee = ChercherLeJourDeLaSalle(Sheets(ListeDesSalles(NumeroSalle)), 1, JourATrouver)
                     If ColonneTrouvee > 0 Then
 
                        ' Si la colonne du jour est trouvée, recherche de l'existence du matériel
                        ChercherLeMaterielPourLaSalle Sheets(ListeDesSalles(NumeroSalle)), ColonneTrouvee, CelluleMaterielREC
 
                        ' Si le matériel est utilisé pour les périodes J ou N, mise à jour des cellules dans l'onglet REC
 
                        ' Période J
                        If ValeurJ <> "" Then
                           With CelluleMaterielREC.Offset(0, J - 1)
                                .Value = ValeurJ
                                If AnomalieDispoJ > 1 Then .Value = .Value & "*" & CStr(AnomalieDispoJ)
 
                                If Not .Comment Is Nothing Then
                                   .Comment.Delete
                                   .AddComment Text:=SallesDuMaterielJ
                                Else
                                   .AddComment Text:=SallesDuMaterielJ
                                End If
                           End With
                        End If
 
                        ' Période N
                        If ValeurN <> "" Then
                           With CelluleMaterielREC.Offset(0, J + 1 - 1)
                                .Value = ValeurN
                                If AnomalieDispoN > 1 Then .Value = .Value & "*" & CStr(AnomalieDispoN)
                                If Not .Comment Is Nothing Then
                                   .Comment.Delete
                                   .AddComment Text:=SallesDuMaterielN
                                Else
                                   .AddComment Text:=SallesDuMaterielN
                                End If
                           End With
                        End If
                     End If
                Next NumeroSalle
             Next J
 
         Next CelluleMaterielREC
         Set AireMaterielREC = Nothing
 
    End With
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
Function ChercherLeJourDeLaSalle(ByVal SalleDeLaRecherche As Worksheet, ByVal TitreSalle As Long, ByVal JourChoisi As String) As Long
 
Dim K As Long
Dim DerniereColonne As Long
 
        ChercherLeJourDeLaSalle = 0
        With SalleDeLaRecherche
             DerniereColonne = .Cells(TitreSalle + 1, .Columns.Count).End(xlToLeft).Column
             For K = 1 To DerniereColonne
                 If .Cells(TitreSalle, K) = JourChoisi Then
                    ChercherLeJourDeLaSalle = K
                    Exit Function
                 End If
             Next K
        End With
 
End Function

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Sub ChercherLeMaterielPourLaSalle(ByVal SalleDeLaRecherche As Worksheet, ByVal ColonneSalle As Long, ByVal MaterielChoisi As String)
 
Dim DerniereLigneSalle As Long
Dim AireMaterielSalle As Range
Dim CelluleMaterielSalle As Range
 
        ValeurJ = ""
        ValeurN = ""
        With SalleDeLaRecherche
 
             DerniereLigneSalle = .Cells(.Rows.Count, 1).End(xlUp).Row
             Set AireMaterielSalle = .Range(.Cells(3, 1), .Cells(DerniereLigneSalle, 1))
 
             For Each CelluleMaterielSalle In AireMaterielSalle
                 If CelluleMaterielSalle = MaterielChoisi Then
                    If CelluleMaterielSalle.Offset(0, ColonneSalle - 1) <> "" Then
                        ValeurJ = "I"
                        AnomalieDispoJ = AnomalieDispoJ + 1
                        SallesDuMaterielJ = SallesDuMaterielJ & SalleDeLaRecherche.Name
                    End If
 
                    If CelluleMaterielSalle.Offset(0, ColonneSalle + 2 - 1) <> "" Then
                       ValeurN = "I"
                       AnomalieDispoN = AnomalieDispoN + 1
                       SallesDuMaterielN = SallesDuMaterielN & SalleDeLaRecherche.Name
                    End If
                 End If
             Next CelluleMaterielSalle
 
            Set AireMaterielSalle = Nothing
 
        End With
 
End Sub

Pour mieux mettre en évidence les périodes où les matériels ne sont pas disponibles, les cellules apparaissent sur fond jaune. Les réservations en double ou triple sur la même période apparaissent en rouge. Le tout via une MFC.

Les commentaires dans les cellules indiquent les salles retenues.

Pièce jointe 229153



Pièce jointe 229156


De mon point de vue, il serait plus efficace de partir d'une saisie sur les tableaux des salles 1,2,3 , via l'événement Worksheet_Change, chaque matériel utilisé se répercuterait en temps réel sur les deux autres avec une couleur pour indiquer que la période n'est plus disponible et sur REC.


Cordialement.

[cabu37]

Bonsoir,

Merci beaucoupl!!! On voit que je débute

Je suis en train d'adapter le code à mon cas

Ta proposition "saisie sur les tableaux des salles 1,2,3 , via l'événement Worksheet_Change" a l'air super, mais sincèrement je n'ai aucune idée de comment faire ça...

[Menhir]

Ta proposition "saisie sur les tableaux des salles 1,2,3 , via l'événement Worksheet_Change" a l'air super, mais sincèrement je n'ai aucune idée de comment faire ça...

L'aide Excel est ton amie :
https://msdn.microsoft.com/fr-fr/lib.../ff839775.aspx

[cabu37]

Re-Bonjour,

Dans un premier temps j'essaie d'utiliser la solution proposée Par contre, quand je l'adapte à mon tableau j'ai l'impression que les plages sont décalées. Et une petite question, savez-vous comment effacer les commentaires quand il y a une mise à jour? En effet, le commentaire de la salle reste même si la salle est disponible à nouveau.

Voici mon petit fichier.Dispo.xlsm

[Invité]

Bonjour,

Votre fichier n'a plus rien à voir à celui d'origine.

Savez-vous comment effacer les commentaires quand il y a une mise à jour? En effet, le commentaire de la salle reste même si la salle est disponible à nouveau.

Modifiez le code la macro MajDisponibiliteDuMateriel, en insérant le code suivant après Set AireMaterielREC = .Range(.Cells(7, 3), .Cells(DerniereLigneREC, 3))

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
         For Each CelluleMaterielREC In .Range(AireMaterielREC.Offset(0, 2), AireMaterielREC.Offset(DerniereLigneREC, DerniereColonneREC - 3))
             If Not CelluleMaterielREC.Comment Is Nothing Then CelluleMaterielREC.Comment.Delete
         Next CelluleMaterielREC

Dans un premier temps j'essaie d'utiliser la solution proposée Par contre, quand je l'adapte à mon tableau j'ai l'impression que les plages sont décalées.

Dans la macro ChercherLeMaterielPourLaSalle, il vous faut faire autant de boucles que de colonnes de matériels et en réinitialisant l'aire de recherche de cette façon par exemple.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
              For DecalageColonne = 0 To 3
                 ColonneDeReference = 6 + DecalageColonne
                Set AireMaterielSalle = .Range(.Cells(8, ColonneDeReference), .Cells(DerniereLigneSalle, ColonneDeReference))
                For Each CelluleMaterielSalle In AireMaterielSalle

Nb La variable ColonneDeReference étant déclarée dans la macro.

Il faut également réinitialiser les variables ValeurJ et ValeurN dans la boucle Balayage des salles dans la macro MajDisponibiliteDuMateriel

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
                  ' Balayage des salles
                 For NumeroSalle = 0 To 4
                     ' Recherche du jour choisi dans chaque salle
                    ValeurJ = ""
                    ValeurN = ""
                    ColonneTrouvee = ChercherLeJourDeLaSalle(Sheets(ListeDesSalles(NumeroSalle)), 5, JourATrouver)

Et également tenir compte du décalage de la colonne matériel dans l'onglet REC :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

With CelluleMaterielREC.Offset(0, J - 1)

A remplacer par :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

With CelluleMaterielREC.Offset(0, J - 3)

Vous aurez remarqué que la ligne de recherche pour ColonneTrouvee est la ligne 5. La fonction est donc à modifier, car vous avez codé la ligne en dur.

D'où la nécessité de bien cogiter le cahier des charges avant de se lancer dans le code..... Ce sont des heures de programmation en moins.

Cordialement.