Extraction Données selon Critères

Bonjour à tous,

Je vous joins mon fichier sur lequel je travaille.

Il s'agit de la gestion d'emploi du temps de professeur.

Pour le moment j'ai deux types d'onglets dans mon classeur :

  • ceux que je qualifierai d'administratifs ("Cours!" + "Administratif!")
  • ceux que je qualifierai de profs ("Martin!" + "Paul!" + "Jean!")

Sur l'onglet cours, je rentre manuellement les données pour chaque prof (matière à enseigner, heure de début de cours, heure de fin de cours, jour...) Grâce à une formule excel présente sur chaque onglet de prof, la mise à jour depuis l'onglet Cours! se fait automatiquement.

Ce qui m'intéresse maintenant, c'est d'avoir sur l'onglet Cours! une fonction qui me permettrait de connaître les disponibilités de tous mes profs, selon le critère de jour, et de plage horaire, sans avoir à parcourir tous les onglets. La difficulté réside dans les critères. En effet le nom du/des professeurs m'est communiqué si et seulement si:

- Le professeur est libre à toutes les plages sélectionnées (ex: le lundi de 8.30 à 11.00)

Toutefois il se peut que le professeur n'ait pas de cours à ce moment là, mais si les plages sont grisées, celà signifie que le professeur n'est pas de service à ce moment là.

Et si en plus le nom du/des profs apparaissaient en Message Box, ça serait le kiff!

Je vous laisse maintenant jeter un oeil à mon fichier et me dire si qqch est envisageable ou pas. (PS: je n'ai pu mettre que la version 2007, car ma formule ne marche pas avec les versions antérieures)

[lien périmé]

PS : Ne vous étonnez pas de trouver ce sujet sur d'autres forums, j'essaye de glaner les informations comme je peux Bonne journée!

Voici le code que j'ai pondu, mais ça ne marche pas... Qq'un aurait une idée?

Sub QuiEstDispo2()

Dim ValeurRecherche, RangePlage
Dim Jour As String, Debut As String, Fin As String
Dim Colonne As Integer, RangeeD As Integer, RangeeF As Integer
Dim NomdeProf As Range

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With

Set DicoProfs = CreateObject("Scripting.Dictionary")

Jour = InputBox("Quel Jour?")

Select Case Jour
    Case "Lundi": Colonne = 3
    Case "Mardi": Colonne = 4
    Case "Mercredi": Colonne = 5
    Case "Jeudi": Colonne = 6
    Case "Vendredi": Colonne = 7
    Case "Samedi": Colonne = 8
End Select

Debut = InputBox("De quelle heure?")

Select Case Debut
    Case "08:00:00": RangeeD = 4
    Case "08:30:00": RangeeD = 5
    Case "09:00:00": RangeeD = 6
    Case "09:30:00": RangeeD = 7
    Case "10:00:00": RangeeD = 8
    Case "10:30:00": RangeeD = 9
    Case "11:00:00": RangeeD = 10
    Case "11:30:00": RangeeD = 11
    Case "12:00:00": RangeeD = 12
    Case "12:30:00": RangeeD = 13
    Case "13:00:00": RangeeD = 14
    Case "13:30:00": RangeeD = 15
    Case "14:00:00": RangeeD = 16
    Case "14:30:00": RangeeD = 17
    Case "15:00:00": RangeeD = 18
    Case "15:30:00": RangeeD = 19
    Case "16:00:00": RangeeD = 20
    Case "16:30:00": RangeeD = 21
    Case "17:00:00": RangeeD = 22
    Case "17:30:00": RangeeD = 23
    Case "18:00:00": RangeeD = 24
End Select

Fin = InputBox("Jusqu'à quelle heure?")
Select Case Fin
    Case "08:00:00": RangeeF = 4
    Case "08:30:00": RangeeF = 5
    Case "09:00:00": RangeeF = 6
    Case "09:30:00": RangeeF = 7
    Case "10:00:00": RangeeF = 8
    Case "10:30:00": RangeeF = 9
    Case "11:00:00": RangeeF = 10
    Case "11:30:00": RangeeF = 11
    Case "12:00:00": RangeeF = 12
    Case "12:30:00": RangeeF = 13
    Case "13:00:00": RangeeF = 14
    Case "13:30:00": RangeeF = 15
    Case "14:00:00": RangeeF = 16
    Case "14:30:00": RangeeF = 17
    Case "15:00:00": RangeeF = 18
    Case "15:30:00": RangeeF = 19
    Case "16:00:00": RangeeF = 20
    Case "16:30:00": RangeeF = 21
    Case "17:00:00": RangeeF = 22
    Case "17:30:00": RangeeF = 23
    Case "18:00:00": RangeeF = 24
End Select

RangePlage = Range(Cells(RangeeD, Colonne), Cells(RangeeF, Colonne)).Address
NomdeProf = Cells(1, 5).Value

For Each ValeurRecherche In Range(RangePlage)
    If Not DicoProfs.Exists(NomdeProf.Value) And ValeurRecherche.Value = "" Then
        MonDicoDeProfs.Add NomdeProf.Value, NomdeProf.Value
    End If
Next ValeurRecherche

MsgBox (Application.Transpose(MonDicoDeProfs.Items))

End Sub

Bonjour

Pas trop testé

Bonsoir à tous,

Guillaume,

Je ne réponds pas aux MP non sollicités,

as-tu vu la version de Banzai64 ? , à mon avis la meilleure.

Ceci dit,

si tu veux des détails sur ma macro, merci de poster tes questions à la suite du fil

Amicalement

Claude

Merci à vous tous!

Banzai,

Je reviens vers toi après un petit moment...

J'ai donc finalement opté pour ta solution sur les conseils donnés par les autres membres.

Toutefois, je me rends compte que la box me donne aussi en résultat des professeurs qui ne devraient pas en faire partie: ceux qui ont colorié leurs cellules pour me signaler qu'il ne souhaite pas travailler ces périodes là... J'ai tenté d'insérer cette condition de cellule vides et blanches, mais rien n'y fait.. Aurais-tu une idée?

Merci d'avance

Bonjour

Pour la macro je ne me suis basé que sur la feuille "Cours"

Je n'ai tenu compte en aucune manière des feuilles profs

Je crois que Dubois avait fait sa macro dans ce sens

A toi de voir

Sinon il faut repenser toute la macro afin d'inclure cette condition

Merci Banzai!

Ouais j'ai vu ça après coup.. Du coup je me penche sur la soluce de dubois mais c'est pareil... En fait celle de Dubois, exclut les profs dont toutes les cellules coloriées de la plage horaire choisie. Et c'est très bien. Mais si dans la plage choisie il y a une seule cellule non-coloriée, du coup la macro n'exclut pas le profs... :-/

Bonsoir,

Avec la solution de Banzai64,

il te suffirait de mettre les indisponibilités dans la feuille "Cours"

exemple :

capturer

çà devrait marcher !

Amicalement

Claude

Bonjour,

Pas de suite ?

Amicalement

Claude

Si si! J'ai du en fait réadapter mon système pour que ça marche avec cette méthode.

Je viens de terminer ça!

Merci encore à vous deux!

Rechercher des sujets similaires à "extraction donnees criteres"