Retrouver mes locaux libres

Bonjour,
J'ai immaginé cette Function où LocauxUtilisés est la zone de cellules à
une colonne (donc pour une heure donnée) où se situe les locaux utilisés

Mais ça ne marche pas et je sèche lamentablement.
J'obtiens à la ligne du If then l'erreur suivante <L'indice n'appartient
pas à la sélection.>
Si quelqu'un peut corriger la réponse ? ;-))))


ps : je ne sais donc pas si mon idée de join est valable ... :-(((

Jc
Public Function LocauxVides(LocauxUtilisés As Range)
Dim i As Integer
Dim j As Integer
Dim tabLocauxPossibles() As Variant
Dim tabLocauxUtilisés() As Variant
tabLocauxPossibles = Range("DATA!LocauxPossibles")
tabLocauxUtilisés = Range(LocauxUtilisés.Address)
For i = LBound(tabLocauxPossibles) To UBound(tabLocauxPossibles)
For j = LBound(tabLocauxUtilisés) To UBound(tabLocauxUtilisés)
If tabLocauxPossibles(i) = tabLocauxUtilisés(j) Then
tabLocauxPossibles(i) = "": Exit For
Next j
Next i
LocauxVides = Join(tabLocauxPossibles, "-")
End Function

Bonjour Wip

Dans la feuille DATA, j'ai nommé la zone des salles "salles"

Dans la feuille de saisie,
colonne A, à partir de la ligne 2, les noms des groupes
ligne 1, de B1 à I1, les heures (H1 à H8)

Dans le module de chaque feuille jour :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim col As Integer, lig As Integer
Dim tableau(), trouvé
Dim i As Integer, compteur As Integer
Dim présent As Integer, posEcrire As Integer

' lig = numéro de la dernière ligne remplie
lig = Me.Range("A500").End(xlUp).Row
If Not Intersect(Target, Range("B2").Resize(lig - 1, 8)) Is Nothing
Then

col = Target.Column - 1
ReDim tableau(1 To Sheets("DATA").Range("salles").Rows.Count)

For i = 1 To lig
If Range("A1").Offset(i, col) <> "" Then
trouvé = Application.Match([A1].Offset(i, col), _
Sheets("DATA").Range("salles"), 0)
If Not IsError(trouvé) Then
compteur = compteur + 1
tableau(compteur) = Application.Match([A1].Offset(i, col), _
Sheets("DATA").Range("salles"), 0)
End If
End If
Next

tableau = Sort(tableau, False)

présent = 1
posEcrire = 1
For i = UBound(tableau) To 1 Step -1

If i = tableau(présent) Then
présent = présent + 1
Else
Me.Cells(lig + 1 + posEcrire, col + 1).Formula = i
posEcrire = posEcrire + 1
End If
Next
Me.Cells(lig + 1 + posEcrire, col + 1).ClearContents
End If
End Sub

dans un module standart :

Function Sort(ToSort As Variant, Optional SortAscending As Boolean =
True)

' Chris Rae's VBA Code Archive - http://chrisrae.com/vba
' By Chris Rae, 19/5/99. My thanks to
' Will Rickards and Roemer Lievaart for some fixes.

Dim AnyChanges As Boolean
Dim BubbleSort As Long
Dim SwapFH As Variant

Do
AnyChanges = False
For BubbleSort = LBound(ToSort) To UBound(ToSort) - 1
If (ToSort(BubbleSort) > ToSort(BubbleSort + 1) And SortAscending) _
Or (ToSort(BubbleSort) < ToSort(BubbleSort + 1) And Not SortAscending)
_
Then
' These two need to be swapped
SwapFH = ToSort(BubbleSort)
ToSort(BubbleSort) = ToSort(BubbleSort + 1)
ToSort(BubbleSort + 1) = SwapFH
AnyChanges = True
End If
Next BubbleSort
Loop Until Not AnyChanges
Sort = ToSort
End Function

La liste des salles disponibles s'actualise chaque fois que tu déplaces
ta sélection

Bonne journée
Damien

Bonjour à tous

J'utilise excel pour filtrer de diverses manières un
horaire d'occupation des locaux
Mais il me manque un résultat que je ne parviens pas à
construire.
Soit une feuille par jour de la semaine (Lun, Mar, Mer...)
H1 à H8 sont les 8 colonnes qui représentent les heures
Chaque ligne contient un groupe d'étudiants
A l'intersection, un local (A1, A2, .. B1, B2, ....)
Et dans une feuille DATA la liste complète de mes locaux
Comment pourrais-je faire apparaître en bas de chaque
colonne (H1...H8)le liste des locaux libres pour chacune
des heures concernées

Ainsi dans le bas de la colonne H1 le lundi je veux voir
apparaître A4, C2, D1 qui sont par exemple les 3 locaux
de ma liste qui ne sont pas réservés dans les lignes
précédentes de cette même colonne

J'espère me faire à peu près comprendre

Merci à tous ceux qui essaieront de m'aider.

WiP

Bonjour *Jean-Claude*

Merci Jean-Claude.
Je pense avoir compris l'idée et jevais tenter de la concrétiser

WiP

| Bonjour,
| J'ai immaginé cette Function où LocauxUtilisés est la zone de
| cellules à une colonne (donc pour une heure donnée) où se situe les
| locaux utilisés
|
| Mais ça ne marche pas et je sèche lamentablement.
| J'obtiens à la ligne du If then l'erreur suivante <L'indice
| n'appartient pas à la sélection.>
| Si quelqu'un peut corriger la réponse ? ;-))))
|
|
| ps : je ne sais donc pas si mon idée de join est valable ... :-(((
|
| Jc
| Public Function LocauxVides(LocauxUtilisés As Range)
| Dim i As Integer
| Dim j As Integer
| Dim tabLocauxPossibles() As Variant
| Dim tabLocauxUtilisés() As Variant
| tabLocauxPossibles = Range("DATA!LocauxPossibles")
| tabLocauxUtilisés = Range(LocauxUtilisés.Address)
| For i = LBound(tabLocauxPossibles) To UBound(tabLocauxPossibles)
| For j = LBound(tabLocauxUtilisés) To UBound(tabLocauxUtilisés)
| If tabLocauxPossibles(i) = tabLocauxUtilisés(j) Then
| tabLocauxPossibles(i) = "": Exit For
| Next j
| Next i
| LocauxVides = Join(tabLocauxPossibles, "-")
| End Function

Bonjour *Damien Kergosien*

Un tout grand merci à toi Damien
Je me jette à l'eau et essaie de mettre tout cela en oeuvre

WiP

| Dans la feuille DATA, j'ai nommé la zone des salles "salles"
|
| Dans la feuille de saisie,
| colonne A, à partir de la ligne 2, les noms des groupes
| ligne 1, de B1 à I1, les heures (H1 à H8)
|
| Dans le module de chaque feuille jour :
|
| Private Sub Worksheet_SelectionChange(ByVal Target As Range)
| Dim col As Integer, lig As Integer
| Dim tableau(), trouvé
| Dim i As Integer, compteur As Integer
| Dim présent As Integer, posEcrire As Integer
|
| ' lig = numéro de la dernière ligne remplie
| lig = Me.Range("A500").End(xlUp).Row
| If Not Intersect(Target, Range("B2").Resize(lig - 1, 8)) Is Nothing
| Then
|
| col = Target.Column - 1
| ReDim tableau(1 To Sheets("DATA").Range("salles").Rows.Count)
|
| For i = 1 To lig
| If Range("A1").Offset(i, col) <> "" Then
| trouvé = Application.Match([A1].Offset(i, col), _
| Sheets("DATA").Range("salles"), 0)
| If Not IsError(trouvé) Then
| compteur = compteur + 1
| tableau(compteur) = Application.Match([A1].Offset(i, col), _
| Sheets("DATA").Range("salles"), 0)
| End If
| End If
| Next
|
| tableau = Sort(tableau, False)
|
| présent = 1
| posEcrire = 1
| For i = UBound(tableau) To 1 Step -1
|
| If i = tableau(présent) Then
| présent = présent + 1
| Else
| Me.Cells(lig + 1 + posEcrire, col + 1).Formula = i
| posEcrire = posEcrire + 1
| End If
| Next
| Me.Cells(lig + 1 + posEcrire, col + 1).ClearContents
| End If
| End Sub
|
| dans un module standart :
|
| Function Sort(ToSort As Variant, Optional SortAscending As Boolean | True)
|
| ' Chris Rae's VBA Code Archive - http://chrisrae.com/vba
| ' By Chris Rae, 19/5/99. My thanks to
| ' Will Rickards and Roemer Lievaart for some fixes.
|
| Dim AnyChanges As Boolean
| Dim BubbleSort As Long
| Dim SwapFH As Variant
|
| Do
| AnyChanges = False
| For BubbleSort = LBound(ToSort) To UBound(ToSort) - 1
| If (ToSort(BubbleSort) > ToSort(BubbleSort + 1) And SortAscending) _
| Or (ToSort(BubbleSort) < ToSort(BubbleSort + 1) And Not SortAscending)
| _
| Then
| ' These two need to be swapped
| SwapFH = ToSort(BubbleSort)
| ToSort(BubbleSort) = ToSort(BubbleSort + 1)
| ToSort(BubbleSort + 1) = SwapFH
| AnyChanges = True
| End If
| Next BubbleSort
| Loop Until Not AnyChanges
| Sort = ToSort
| End Function
|
| La liste des salles disponibles s'actualise chaque fois que tu
| déplaces ta sélection
|
| Bonne journée

Bonjour Wip

un oubli

C'est la position de la salle libre qui s'affiche.

remplacer
Me.Cells(lig + 1 + posEcrire, col + 1).Formula = i

par

Me.Cells(lig + 1 + posEcrire, col + 1).Formula = _
Sheets("DATA").Range("salles").Offset(i - 1).Value

Damien

Dans la feuille DATA, j'ai nommé la zone des salles "salles"

Dans la feuille de saisie,
colonne A, à partir de la ligne 2, les noms des groupes
ligne 1, de B1 à I1, les heures (H1 à H8)

Dans le module de chaque feuille jour :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim col As Integer, lig As Integer
Dim tableau(), trouvé
Dim i As Integer, compteur As Integer
Dim présent As Integer, posEcrire As Integer

' lig = numéro de la dernière ligne remplie
lig = Me.Range("A500").End(xlUp).Row
If Not Intersect(Target, Range("B2").Resize(lig - 1, 8)) Is Nothing
Then

col = Target.Column - 1
ReDim tableau(1 To Sheets("DATA").Range("salles").Rows.Count)

For i = 1 To lig
If Range("A1").Offset(i, col) <> "" Then
trouvé = Application.Match([A1].Offset(i, col), _
Sheets("DATA").Range("salles"), 0)
If Not IsError(trouvé) Then
compteur = compteur + 1
tableau(compteur) = Application.Match([A1].Offset(i, col), _
Sheets("DATA").Range("salles"), 0)
End If
End If
Next

tableau = Sort(tableau, False)

présent = 1
posEcrire = 1
For i = UBound(tableau) To 1 Step -1

If i = tableau(présent) Then
présent = présent + 1
Else
Me.Cells(lig + 1 + posEcrire, col + 1).Formula = i
posEcrire = posEcrire + 1
End If
Next
Me.Cells(lig + 1 + posEcrire, col + 1).ClearContents
End If
End Sub

dans un module standart :

Function Sort(ToSort As Variant, Optional SortAscending As Boolean >> True)

' Chris Rae's VBA Code Archive - http://chrisrae.com/vba
' By Chris Rae, 19/5/99. My thanks to
' Will Rickards and Roemer Lievaart for some fixes.

Dim AnyChanges As Boolean
Dim BubbleSort As Long
Dim SwapFH As Variant

Do
AnyChanges = False
For BubbleSort = LBound(ToSort) To UBound(ToSort) - 1
If (ToSort(BubbleSort) > ToSort(BubbleSort + 1) And SortAscending) _
Or (ToSort(BubbleSort) < ToSort(BubbleSort + 1) And Not SortAscending)
_
Then
' These two need to be swapped
SwapFH = ToSort(BubbleSort)
ToSort(BubbleSort) = ToSort(BubbleSort + 1)
ToSort(BubbleSort + 1) = SwapFH
AnyChanges = True
End If
Next BubbleSort
Loop Until Not AnyChanges
Sort = ToSort
End Function

La liste des salles disponibles s'actualise chaque fois que tu
déplaces ta sélection

Bonne journée

Bonjour *Damien Kergosien*


Superbe Damien. Même le service après-vente :)
J'ai modifié ainsi la première boucle For Next sinon l'indice dépasse la longueur du tableau

Et la boucle finale qui écrivait en commençant par la fin
Il me reste un problème à régler. Il m'écrit toute la liste et pas seulement les salles libres.
Je cherche
WiP

Dim col As Integer, lig As Integer
Dim tableau(), trouvé
Dim i As Integer, compteur As Integer
Dim présent As Integer, posEcrire As Integer
' lig = numéro de la dernière ligne remplie
lig = Me.Range("A500").End(xlUp).Row
If Not Intersect(Target, Range("B2").Resize(lig - 1, 8)) Is Nothing Then
col = Target.Column - 1
ReDim tableau(1 To Sheets("DATA").Range("SALLES").Rows.Count)
For i = 1 To lig
==> compteur = 0
If Range("A1").Offset(i, col) <> "" Then
trouvé = Application.Match([A1].Offset(i, col), Sheets("DATA").Range("SALLES"), 0)
If Not IsError(trouvé) Then
compteur = compteur + 1
tableau(compteur) = Application.Match([A1].Offset(i, col), Sheets("DATA").Range("SALLES"), 0)
End If
End If
Next
tableau = Sort(tableau, False)
présent = 1
==> posEcrire = UBound(tableau)
For i = UBound(tableau) To 1 Step -1
If i = tableau(présent) Then
présent = présent + 1
Else
Me.Cells(lig + 1 + posEcrire, col + 1).Formula = Sheets("DATA").Range("salles").Offset(i - 1).Value
==> posEcrire = posEcrire - 1
End If
Next
Me.Cells(lig + 1 + posEcrire, col + 1).ClearContents
End If
End Sub


| un oubli
|
| C'est la position de la salle libre qui s'affiche.
|
| remplacer
| Me.Cells(lig + 1 + posEcrire, col + 1).Formula = i
|
| par
|
| Me.Cells(lig + 1 + posEcrire, col + 1).Formula = _
| Sheets("DATA").Range("salles").Offset(i - 1).Value
|
| Damien
|

WiP avait prétendu :

Bonjour *Damien Kergosien*


Superbe Damien. Même le service après-vente :)
J'ai modifié ainsi la première boucle For Next sinon l'indice dépasse la
longueur du tableau

Et la boucle finale qui écrivait en commençant par la fin
Il me reste un problème à régler. Il m'écrit toute la liste et pas seulement
les salles libres. Je cherche
WiP

Il t'écrit toute la liste car tu as modifié la boucle For Next.
Je n'ai pas réussi à faire autrement. (pas beaucoup cherché non plus).

Le principe : les lignes de la zone saisie de la colonne où est le
curseur sont parcourues. Si elles contiennent une donnée qui se trouve
dans la liste salles, le numéro de la ligne (salle)est mémorisé dans
tableau.
En fin de boucle, le tableau est trié en ordre décroissant de façon à
avoir les données numériques en premier.
Dans la boucle For Next, on commence par la dernière ligne des salles.
Si elle est présente, on passe, sinon, on l'écrit ?

dans l'autre sens, on devrait pouvoir le faire mais je n'ai pas eu
envie de me casser la tête.

Damien

Salut,
En remplissant les tableux indice après indice ça marche
A toi de voir
A+

Public Function LocauxVides(LocauxUtilisés As Range)
Dim i As Integer
Dim j As Integer
Dim tabLocauxPossibles() As Variant
Dim tabLocauxUtilisés() As Variant

ReDim tabLocauxPossibles(Range("DATA!LocauxPossibles").Rows.Count)
For i = LBound(tabLocauxPossibles) To UBound(tabLocauxPossibles) - 1
tabLocauxPossibles(i) Sheets("DATA").Cells(Range("LocauxPossibles").Row,
Range("LocauxPossibles").Column).Offset(i)
Next i

ReDim tabLocauxUtilisés(Range(LocauxUtilisés.Address).Rows.Count)
For i = LBound(tabLocauxUtilisés) To UBound(tabLocauxUtilisés) - 1
tabLocauxUtilisés(i) = Cells(Range(LocauxUtilisés.Address).Row,
Range(LocauxUtilisés.Address).Column).Offset(i)
Next i

For i = LBound(tabLocauxPossibles) To UBound(tabLocauxPossibles)
For j = LBound(tabLocauxUtilisés) To UBound(tabLocauxUtilisés)
If tabLocauxPossibles(i) = tabLocauxUtilisés(j) Then
tabLocauxPossibles(i) = "": Exit For
Next j
Next i

For i = LBound(tabLocauxPossibles) To UBound(tabLocauxPossibles)
If tabLocauxPossibles(i) <> "" Then
If tmp = "" Then
tmp = tabLocauxPossibles(i)
Else
tmp = tmp & " - " & tabLocauxPossibles(i)
End If
End If
Next i
LocauxVides = tmp
End Function

Bonjour Wip

L'idée la fonction était intéressante.
Ce qui me gènait, c'était la présentation.

Comme je peux avoir besoin de ce genre de fonction, J'ai modifié le
traitement en une fonction polyvalente.
Je suppose que to travail est au point.

Je te la mets pour le plaisir.

Function ListeAbsents(zoneSaisie As Range, listeRéférence As Range,
Optional carSéparateur As String)
' liste les éléments de la zone saisie qui ne sont pas dans
listeRéférence
' si la liste référence est plus large large que haute met éléments en
ligne,
' mets les éléments en colonne. Formater cellule Renvoyer à la ligne
automatiquement
' mettre hauteur de ligne suffisante

' Damien Kergosien septembre 2004

Dim c As Range, trouvé, i
Dim tableau(), locaux(), tmp As String
Dim séParateur As String

If carSéparateur = "" Then carSéparateur = " - "

ReDim tableau(1 To listeRéférence.Rows.Count)
ReDim locaux(1 To listeRéférence.Rows.Count)

i = 1
For Each c In listeRéférence
locaux(i) = c.Value
i = i + 1
Next

For Each c In zoneSaisie
If c.Value <> "" Then
trouvé = Application.Match(c.Value, _
listeRéférence, 0)
If Not IsError(trouvé) Then
tableau(trouvé) = c.Value
End If
End If
Next

tmp = ""
If zoneSaisie.Rows.Count > zoneSaisie.Columns.Count Then
séParateur = Chr$(10)
Else
séParateur = carSéparateur
End If

For i = 1 To UBound(tableau)
If tableau(i) = "" Then
If tmp = "" Then
tmp = locaux(i)
Else
tmp = tmp & séParateur & locaux(i)
End If
End If
Next

ListeAbsents = tmp
End Function


Damien

Bonjour *D. Kergosien*


Chapeau bas. La touche qui manquait à la fonction de Jean-Claude pour la rendre universelle
Perso, j'avais réglé le problème de l'affichage en remplaçant le séparateur par chr$(10)
Ainsi finalisée cette fonction va me servir dans plusieurs autres applications

Encore merci à tous les deux.
WiP

| Bonjour Wip
|
| L'idée la fonction était intéressante.
| Ce qui me gènait, c'était la présentation.
|
| Comme je peux avoir besoin de ce genre de fonction, J'ai modifié le
| traitement en une fonction polyvalente.
| Je suppose que to travail est au point.
|
| Je te la mets pour le plaisir.
|
| Function ListeAbsents(zoneSaisie As Range, listeRéférence As Range,
| Optional carSéparateur As String)
| ' liste les éléments de la zone saisie qui ne sont pas dans
| listeRéférence
| ' si la liste référence est plus large large que haute met éléments en
| ligne,
| ' mets les éléments en colonne. Formater cellule Renvoyer à la ligne
| automatiquement
| ' mettre hauteur de ligne suffisante
|
| ' Damien Kergosien septembre 2004
|
| Dim c As Range, trouvé, i
| Dim tableau(), locaux(), tmp As String
| Dim séParateur As String
|
| If carSéparateur = "" Then carSéparateur = " - "
|
| ReDim tableau(1 To listeRéférence.Rows.Count)
| ReDim locaux(1 To listeRéférence.Rows.Count)
|
| i = 1
| For Each c In listeRéférence
| locaux(i) = c.Value
| i = i + 1
| Next
|
| For Each c In zoneSaisie
| If c.Value <> "" Then
| trouvé = Application.Match(c.Value, _
| listeRéférence, 0)
| If Not IsError(trouvé) Then
| tableau(trouvé) = c.Value
| End If
| End If
| Next
|
| tmp = ""
| If zoneSaisie.Rows.Count > zoneSaisie.Columns.Count Then
| séParateur = Chr$(10)
| Else
| séParateur = carSéparateur
| End If
|
| For i = 1 To UBound(tableau)
| If tableau(i) = "" Then
| If tmp = "" Then
| tmp = locaux(i)
| Else
| tmp = tmp & séParateur & locaux(i)
| End If
| End If
| Next
|
| ListeAbsents = tmp
| End Function
|
|
| Damien