Repérer les absents et les déjà présents

Comment, à partir de la liste des élèves présents aujourd'hui, et connaissant la liste de référence des élèves de la classe, repérer les absents et en faire la liste dans une seule cellule ? Comment également renvoyer dans une cellule le nom des éléments apparaissant plus d'une fois dans une liste, avec le nombre d'occurrences ?

Tu peux utiliser suivant les cas l'une ou l'autre de ces deux fonctions :

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,
 ' sinon met les éléments en colonne. Formater cellule Renvoyer à la ligne automatiquement
 ' mettre hauteur de ligne suffisante
 ' Damien Kergosien septembre 2004
 Application.Volatile
 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
 Function Doubles(zoneSaisie As Range, listeRéférence As Range, Optional carSéparateur As
 String)
 
 ' liste les éléments de la zone saisie qui sont utilisés plusieurs fois
 ' si la liste référence est plus large large que haute met éléments en ligne,
 ' sinon met les éléments en colonne. Formater cellule Renvoyer à la ligne automatiquement
 ' mettre hauteur de ligne suffisante
 ' Damien Kergosien septembre 2004 - Patrice Wilkin octobre 2004
 
 Application.Volatile
 
 Dim c As Range
 Dim i, j, k As Integer
 Dim saisie(), locaux(), compteur(), tmp As String
 Dim séParateur As String
 
 If carSéparateur = "" Then carSéparateur = " - "
 ReDim saisie(1 To zoneSaisie.Rows.Count)
 ReDim locaux(1 To listeRéférence.Rows.Count)
 ReDim compteur(1 To listeRéférence.Rows.Count)
  
  i = 1
  For Each c In listeRéférence
    locaux(i) = c.Value
    i = i + 1
  Next
  
  i = 1
  For Each c In zoneSaisie
    saisie(i) = c.Value
    i = i + 1
  Next
 
  For i = 1 To listeRéférence.Rows.Count
    k = 0
    For j = 1 To zoneSaisie.Rows.Count
      If saisie(j) = locaux(i) Then
        k = k + 1
      End If
    Next
    compteur(i) = k
  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(locaux)
   If compteur(i) > 1 Then
     If tmp = "" Then
      tmp = locaux(i) & " : " & compteur(i) & carSéparateur
     Else
      tmp = tmp & séParateur & locaux(i) & " : " & compteur(i) & carSéparateur
     End If
   End If
  Next
 
  Doubles = tmp
 End Function
 

Auteur :

Mots clefs associés à cette page : , , ,