Deneyiniz kod ile yaptım.
Private Sub btnAktar_Click()
Dim i As Byte, k As Byte, topla As Integer
Const baslangic As Byte = 3
Const bitis As Byte = 66
Const bitisYarisi As Byte = 33
Const A As String = "A"
Const B As String = "B"
Const D As String = "D"
Const E As String = "E"
Range("I3:J33").ClearContents
'Haftasonu bulmak icin
For i = baslangic To bitis
For k = baslangic To bitis
If k > bitisYarisi Then GoTo var
If Cells(i, B).Value <> "" And Cells(i, B).Value = Cells(k, B).Value Then
If Weekday(Cells(k, A), 2) >= 6 Then topla = topla + 1
End If
var:
If Cells(i, E).Value <> "" And Cells(i, E).Value = Cells(k, E).Value Then
If Weekday(Cells(k, D), 2) >= 6 Then topla = topla + 1
End If
Next
Cells(i, "j").Value = IIf(topla = 0, "", topla)
topla = Empty
Next
topla = Empty
'Haftaici bulmak icin
For i = baslangic To bitis
For k = baslangic To bitis
If k > bitisYarisi Then GoTo var2
If Cells(i, B).Value <> "" And Cells(i, B).Value = Cells(k, B).Value Then
If Weekday(Cells(k, A), 2) < 6 Then topla = topla + 1
End If
var2:
If Cells(i, E).Value <> "" And Cells(i, E).Value = Cells(k, E).Value Then
If Weekday(Cells(k, D), 2) < 6 Then topla = topla + 1
End If
Next
Cells(i, "i").Value = IIf(topla = 0, "", topla)
topla = Empty
Next
End Sub
nöbet hesap listesi.rar
(Dosya Boyutu: 16,75 KB | İndirme Sayısı: 10)