Not:Kod güncellendi....
Private Sub btnAktar_Click()
Dim i As Byte, topla As Integer
Dim son As Byte, adres As String
Dim bul As Range
Range("I3:J" & Rows.Count).ClearContents
'Hafta ici bulmak icin
son = Cells(Rows.Count, "H").End(3).Row
If son < 3 Then GoTo son
For i = 3 To son
If Cells(i, "H").Value <> "" Then
Set bul = Range("B:E").Find(Cells(i, "H").Value, , , 1)
If Not bul Is Nothing Then
adres = bul.Address
Do
If Weekday(bul.Offset(0, -1), 2) < 6 Then topla = topla + 1
Set bul = Range("B:E").FindNext(bul)
Loop While Not bul Is Nothing And bul.Address <> adres
End If
Cells(i, "i").Value = IIf(topla > 0, topla, "")
topla = Empty
Set bul = Nothing
End If
Next
'Hafta sonu bulmak icin
For i = 3 To son
If Cells(i, "H").Value <> "" Then
Set bul = Range("B:E").Find(Cells(i, "H").Value, , , 1)
If Not bul Is Nothing Then
adres = bul.Address
Do
If Weekday(bul.Offset(0, -1), 2) >= 6 Then topla = topla + 1
Set bul = Range("B:E").FindNext(bul)
Loop While Not bul Is Nothing And bul.Address <> adres
End If
Cells(i, "j").Value = IIf(topla > 0, topla, "")
topla = Empty
Set bul = Nothing
End If
Next
son:
On Error Resume Next
Set bul = Nothing
End Sub
