Wie was afwezig

Status
Niet open voor verdere reacties.

Oude leerling

Gebruiker
Lid geworden
30 aug 2010
Berichten
554
Geacht forum,

Onderstaande code , indertijd gekregen van VSH , noteert perfect wie afwezig was maar verwijderd ook meteen de
formules welke in kolom A staan terwijl de datum welke de formules genereerd wel gewoon blijven staan.
Kunt u mij helpen dat deze formules wel gewoon blijven staan??

Jaap

Sub wie_was_afwezig()
Dim sn, sq, i As Long, ii As Long, col As Variant, y As Long
Bekijk bijlage Test , wie was afwezig.xlsm
Code:
With Sheets("blad2")
   sn = .Cells(1).CurrentRegion
   sq = Sheets("blad1").Range("a10:g45")
 For i = 2 To UBound(sn)
     For ii = 1 To UBound(sq)
        If sn(i, 2) = sq(ii, 1) Or sn(i, 2) = sq(ii, 7) Then y = y + 1
     Next ii
        If y = 0 Then
           col = Application.Match(Sheets("blad1").Cells(5, 7), .Rows(1), 0)
           If Not IsError(col) Then sn(i, col) = "x"
         End If
      y = 0
  Next i
 .Cells(1).Resize(UBound(sn), UBound(sn, 2)) = sn
End With
End Sub
 
Puinhoop van gemaakt.
De code moet zijn als hieronder en kolom A moet zijn Rij 1

Jaap



Code:
Sub wie_was_afwezig()
Dim sn, sq, i As Long, ii As Long, col As Variant, y As Long
With Sheets("blad2")
   sn = .Cells(1).CurrentRegion
   sq = Sheets("blad1").Range("a10:g45")
 For i = 2 To UBound(sn)
     For ii = 1 To UBound(sq)
        If sn(i, 2) = sq(ii, 1) Or sn(i, 2) = sq(ii, 7) Then y = y + 1
     Next ii
        If y = 0 Then
           col = Application.Match(Sheets("blad1").Cells(5, 7), .Rows(1), 0)
           If Not IsError(col) Then sn(i, col) = "x"
         End If
      y = 0
  Next i
 .Cells(1).Resize(UBound(sn), UBound(sn, 2)) = sn
End With
End Sub
 
Laatst bewerkt:
Zo beter Jaap?
Code:
Sub wie_was_afwezig()
Dim sn, sq, i As Long, ii As Long, col As Variant, y As Long
With Sheets("blad2")
   sn = .Cells(1).CurrentRegion[COLOR=#0000ff].Offset(1).SpecialCells(2)[/COLOR]
   sq = Sheets("blad1").Range("a10:g45")
 For i = 2 To UBound(sn)
     For ii = 1 To UBound(sq)
        If sn(i, 2) = sq(ii, 1) Or sn(i, 2) = sq(ii, 7) Then y = y + 1
     Next ii
        If y = 0 Then
           col = Application.Match(Sheets("blad1").Cells(5, 7), .Rows(1), 0)
           If Not IsError(col) Then sn(i, col) = "x"
         End If
      y = 0
  Next i
[COLOR=#0000ff] .Cells(2, 1)[/COLOR].Resize(UBound(sn), UBound(sn, 2)) = sn
End With
End Sub
 
Hsv,

Bedankt voor je reactie.
De code zet echter nu helemaal kruisjes meer terwijl er toch leden afwezig zijn.
De formules in rij 1 blijven nu wel staan.
 
In de herkansing.
Code:
Sub wie_was_afwezig()
Dim sn, sq, i As Long, ii As Long, col As Variant, y As Long
With Sheets("blad2")
   sn = .Range("a2", .Cells(Rows.Count, 1).End(xlUp)).Resize(, 19)
   sq = Sheets("blad1").Range("a10:g45")
 For i = 1 To UBound(sn)
     For ii = 1 To UBound(sq)
        If sn(i, 2) = sq(ii, 1) Or sn(i, 2) = sq(ii, 7) Then y = y + 1
     Next ii
        If y = 0 Then
           col = Application.Match(Sheets("blad1").Cells(5, 7), .Rows(1), 0)
           If Not IsError(col) Then sn(i, col) = "x"
         End If
      y = 0
  Next i
 .Cells(2, 1).Resize(UBound(sn), UBound(sn, 2)) = sn
End With
End Sub
 
HSV

Helemaal goed

Dat was het , heel erg bedankt voor je hulp , je bent een kei!!

Vriendelijke groet, Jaap
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan