Extraction Données selon Critères - Excel VBA

Question

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) 

https://www.excel-downloads.com/forums/forum-excel.7/

michel_m · Answer

Merci d'éviter de poser la même question sur plusieurs forums: developpez;com, Excel downloads, Excel -pratique....
Surtout quand c'est coutumier

Guillaume831 · Answer

Michel, 
J'apprécie votre intérêt pour mes posts. Toutefois, si je poste sur plusieurs forums c'est pour avoir des réponses différentes, et de façon plus rapide.
D'autant plus que je remercie à chaque fois chaque participant, et j'essaye de transmettre la réponse que j'ai adoptée afin d'aider un maximum d'utilisateurs, qui ne se connectent pas forcément sur tous les forums.
Celà dit, si je vous agace, veuillez ne pas cliquer sur mes posts.

Cordialement,

Guillaume

michel_m · Answer

veuillez ne pas cliquer sur mes posts.  

AU CONTRAIRE   
Le jour où tu préviendra au départ que tu poses la question sur tel et tel forum, ce sera ok et si je peux, j'essaierai de t'aider en allant regarder les solutions proposées ce qui évitera a chacun de se prendre la t^te pour rien. 

Tu es étudiant, attend toi à de sérieux déboires dans la vie professionnelle avec une telle mentalité 

bénévoles ou collègues=domestiques en concurrence ? 
 Michel

Guillaume831 · Answer

Michel,

Premièrement, et de la façon la plus importante, je ne prends personne pour un domestique, et n'oblige personne à m'aider. Je suis content quand quelqu'un le fait, mais non mécontent dans le cas inverse.

De plus, le fait que j'indique ou pas que mon posts se trouve aussi sur d'autres forums n'empêchera pas les gens qui veulent m'aider de le faire. Mais si ça peut éviter des conflits avec d'autres internautes, je m'en souviendrai.

Par ailleurs, oui je suis étudiant, mais je ne te permets pas de juger ma mentalité, après la lecture de qques uns de mes posts glâné sur le net.

Finalement, sache que je n'aide pas souvent les auteurs de posts sur les forums informatiques, mais en tant que linguiste chevronné, je n'hésite pas à aider des internautes à traduire des mots, expressions, phrases et documents sur les forums spécialisés. Je donne, et je reçois. Je sais faire les deux.

Si tu permets maintenant, j'aimerais que cette discussion sur ce sujet se termine, afin que je puisse me remettre à bosser sur mon projet, maintenant que nos deux points de vue sont exposés.

Respectueusement,

Guillaume

Guillaume831 · Answer

Quelqu'un aurait-il une idée pour me permettre d'avancer? :)

Guillaume831 · Answer

Ok, j'ai pensé à un truc comme ça, qu'en pensez-vous?

Option Explicit

Sub QuiEstDispo()

Dim ValeurRecherche, RangePlage
Dim NomdeProf, RangePlage1
Dim FeuilPlage, SheetsPlage
Dim Début As Range, Fin As Range, Jour As Variant
Dim Column As Range, Rows As Range
Dim MonDicoDeProfs As Variant
Dim I As Integer

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual 'c'est pour que la macro ne rame pas
End With

Jour = Worksheets("Cours").Range("H15").Value 'jour qui nous intéresse pour connaître la dispo du prof - la cellule présente une liste déroulante de Lundi à Samedi
Select Case Jour
    Case "Lundi": Column = 3 ' dans le tableau des profs, le lundi correspond à la colonne C  -donc 3
    Case "Mardi": Column = 4
    Case "Mercredi": Column = 5
    Case "Jeudi": Column = 6
    Case "Vendredi": Column = 7
    Case "Samedi": Column = 8
End Select
    
Début = Worksheets("Cours").Range("I15") 'début de la plage horaire qui nous intéresse pour connaître la dispo du prof

Select Case Début
    Case "08:00:00": Rows = 4
    Case "08:30:00": Rows = 5
    Case "09:00:00": Rows = 6
    Case "09:30:00": Rows = 7
    Case "10:00:00": Rows = 8
    Case "10:30:00": Rows = 9
    Case "11:00:00": Rows = 10
    Case "11:30:00": Rows = 11
    Case "12:00:00": Rows = 12
    Case "12:30:00": Rows = 13
    Case "13:00:00": Rows = 14
    Case "13:30:00": Rows = 15
    Case "14:00:00": Rows = 16
    Case "14:30:00": Rows = 17
    Case "15:00:00": Rows = 18
    Case "15:30:00": Rows = 19
    Case "16:00:00": Rows = 20
    Case "16:30:00": Rows = 21
    Case "17:00:00": Rows = 22
    Case "17:30:00": Rows = 23
    Case "18:00:00": Rows = 24
End Select
    
Fin = Worksheets("Cours").Range("J15") ' fin de la plage horaire qui nous intéresse pour connaître la dispo du prof
Select Case Fin
    Case "08:00:00": Rows = 4
    Case "08:30:00": Rows = 5
    Case "09:00:00": Rows = 6
    Case "09:30:00": Rows = 7
    Case "10:00:00": Rows = 8
    Case "10:30:00": Rows = 9
    Case "11:00:00": Rows = 10
    Case "11:30:00": Rows = 11
    Case "12:00:00": Rows = 12
    Case "12:30:00": Rows = 13
    Case "13:00:00": Rows = 14
    Case "13:30:00": Rows = 15
    Case "14:00:00": Rows = 16
    Case "14:30:00": Rows = 17
    Case "15:00:00": Rows = 18
    Case "15:30:00": Rows = 19
    Case "16:00:00": Rows = 20
    Case "16:30:00": Rows = 21
    Case "17:00:00": Rows = 22
    Case "17:30:00": Rows = 23
    Case "18:00:00": Rows = 24
End Select

Set MonDicoDeProfs = CreateObject("Scripting.Dictionary") 'pour me donner le  nom des profs qui correspondent aux crières

RangePlage = Range(Cells(Début, Jour), Cells(Fin, Jour)).Address
NomdeProf = Cells(1, 5).Value
FeuilPlage = Range(Sheets(3), Sheets.Count).Address

For Each ValeurRecherche In Application.Sheets(SheetsPlage).Range(RangePlage)
    If Not MonDicoDeProfs.Exists(NomdeProf.Value) And ValeurRecherche.Value = "" And Cells.Interior.Pattern <> xlSolid Then
    MonDicoDeProfs.Add NomdeProf.Value, NomdeProf.Value
    End If
Next ValeurRecherche

MsgBox = (Application.Transpose(MonDicoDeProfs.Items)) 'me donne le nom des profs sous forme de msgbox

End Sub

Extraction Données selon Critères - Excel VBA

6 réponses

Discussions similaires

Newsletters