- Katılım
- 24 Şubat 2009
- Mesajlar
- 1,070
- Excel Vers. ve Dili
- 2016
- Altın Üyelik Bitiş Tarihi
- 01-03-2023
Merhaba arkadaşlar; Elimde bir kod var aşağıda;
Kırmızı ile işaretlediğim kodu bir CheckBox.1 nesnesine bağlamak istiyorum, yani CheckBox.1 aktif olunca Yani centik koyduğumda Kırmızı satırlardaki kod çalışacak, centiği kaldırınca kırmızı satırlardaki kod gösterildiği gibi çalışmayacak. Teşekkürler.Sub Analiz()
Application.ScreenUpdating = False
On Error Resume Next
Set s1 = ThisWorkbook.Worksheets("İZİNLER")
s1.Range("m2:O65536").ClearContents
For i = 2 To s1.Range("B65536").End(xlUp).Row
s1.Cells(i, "m") = s1.Cells(i, "k") - s1.Cells(i, "g")
If s1.Cells(i, "g") = s1.Cells(i, "k") Then s1.Cells(i, "m") = 1
For K = 1 To s1.Cells(i, "m")
sonsatir = s1.Range("N65536").End(xlUp).Row + 1
s1.Cells(sonsatir, "N") = s1.Cells(i, "B") & " " & (s1.Cells(i, "G") + K - 1)
Next K
Next i
Set s2 = ThisWorkbook.Worksheets("PUANTAJ")
For i = 7 To s2.Range("A65536").End(xlUp).Row
s2.Range("F" & i & ":AJ" & i).ClearContents
Next i
sonsatir = s1.Range("N65536").End(xlUp).Row
For i = 7 To s2.Range("E65536").End(xlUp).Row
For K = 6 To 36
aranan = s2.Cells(i, "E") & " " & s2.Cells(6, K)
'If s2.Cells(6, K) <> "" And Format(s2.Cells(6, K), "dddd") <> "Pazar" Then
s2.Cells(i, K) = 1 'Bir rakamı yazıyor.
'End If
If WorksheetFunction.CountIf(s1.Range("N2:N" & sonsatir), aranan) >= 1 Then s2.Cells(i, K) = ""
Next K
Next i
Application.ScreenUpdating = True
End Sub