Kodun bir bölümünü CheckBox.1 tuşuna bağlama

Katılım
24 Şubat 2009
Mesajlar
1,070
Excel Vers. ve Dili
2016
Merhaba arkadaşlar; Elimde bir kod var aşağıda;
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
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.
 
Katılım
29 Ekim 2018
Mesajlar
29
Excel Vers. ve Dili
2016TR
İlgili kod alanını aşağıdaki kod bloğu ile değiştirerek deneyiniz.

If s2.Cells(6, K) <> "" And Format(s2.Cells(6, K), "dddd") <> "Pazar" and CheckBox1.Value = True Then
s2.Cells(i, K) = 1 'Bir rakamı yazıyor.
'End If



ASUS_Z00LD cihazımdan Tapatalk kullanılarak gönderildi
 

muratboz06

Destek Ekibi
Destek Ekibi
Katılım
23 Mart 2017
Mesajlar
552
Excel Vers. ve Dili
Office365 TR
Başka bir yere yüklerseniz bakabilirim, altın üyeliğim bulunmuyor.
 

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
5,803
Excel Vers. ve Dili
2019 Türkçe
Merhaba
kod satırı şöyle olmalı. Checkbox un hangi sayfada olduğunu belirtmelisiniz.

Kod:
If s2.Cells(6, k) <> "" And Format(s2.Cells(6, k), "dddd") <> "Pazar" And Sayfa7.CheckBox1.Value = True Then
 

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
5,803
Excel Vers. ve Dili
2019 Türkçe
Yeni kodlar tam olarak şöyle olmalı.

Kod:
Sub Analiz()
    Application.ScreenUpdating = False
    On Error Resume Next
    Set s1 = ThisWorkbook.Worksheets("İZİNLER")
    s1.Range("N2:O65536").ClearContents
    For i = 2 To s1.Range("B65536").End(xlUp).Row
        For k = 1 To s1.Cells(i, "H") + s1.Cells(i, "I")
            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) <> "" Then
            If Format(s2.Cells(6, k), "dddd") <> "Pazar" Then
                s2.Cells(i, k) = 1
            End If
            If Sayfa7.CheckBox1.Value = True Then
                s2.Cells(i, k) = 1
            End If
        End If
        If WorksheetFunction.CountIf(s1.Range("N2:N" & sonsatir), aranan) >= 1 Then s2.Cells(i, k) = ""
        Next k
    Next i
    Application.ScreenUpdating = True
    MsgBox "BORDRO OLUŞTURULDU.", vbInformation
End Sub
 
Üst