[Catégorie modifiée VB6 -> VBA] Excel VBA - Extraction Données selon Critères

Signaler
Messages postés
28
Date d'inscription
jeudi 5 mai 2011
Statut
Membre
Dernière intervention
18 mai 2011
-
Messages postés
28
Date d'inscription
jeudi 5 mai 2011
Statut
Membre
Dernière intervention
18 mai 2011
-
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)

Fichier Emploi du Temps.

5 réponses

Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
74
Comme on te l'a déjà dit, tu fais du VBA, pas du VB6
Messages postés
28
Date d'inscription
jeudi 5 mai 2011
Statut
Membre
Dernière intervention
18 mai 2011

Merci Jack de la correction!
Messages postés
28
Date d'inscription
jeudi 5 mai 2011
Statut
Membre
Dernière intervention
18 mai 2011

Quelqu'un aurait-il une idée pour me permettre d'avancer? :)
Messages postés
28
Date d'inscription
jeudi 5 mai 2011
Statut
Membre
Dernière intervention
18 mai 2011

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
Messages postés
28
Date d'inscription
jeudi 5 mai 2011
Statut
Membre
Dernière intervention
18 mai 2011

Pas grand chose? ;)