Hücrenin durumuna göre checkboxı onaylı veya onaysız yapma

sinnernekolens

sinnernekolens

Altın Üye
Katılım
23 Temmuz 2009
Mesajlar
310
Excel Vers. ve Dili
Ofis 2019 - Türkçe 64bit
Altın Üyelik Bitiş Tarihi
02-09-2027
İyi günler,
Ekli örnekte görüleceği üzere Checkbox ların durumuna göre G8 VE H8 hücreleri değişkendir.
örneğin H8 hücresine 0,5 diye manuel değer yazdığımda, Checkbox2 otomatik işaretli olsun. H8 hücresinin değeri (0)sıfır ise işaretsiz olsun.
yani hücrenin durumuna göre checkbox onaylı ve onaysız olacak. iki Checkbox içinde aynı durum geçerlidir.
Yardımlarınızı rica ederim.
 

Ekli dosyalar

Orion1

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
dosyanız ektedir.:cool:

Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [G8:H8]) Is Nothing Then Exit Sub
If Target.Column = 7 Then
    If Target.Value > 0 Then
        CheckBox1.Value = True
    Else
        CheckBox1.Value = False
    End If
Else
    If Target.Value > 0 Then
        CheckBox2.Value = True
    Else
        CheckBox2.Value = False
    End If
End If
    
End Sub
 

Ekli dosyalar

sinnernekolens

sinnernekolens

Altın Üye
Katılım
23 Temmuz 2009
Mesajlar
310
Excel Vers. ve Dili
Ofis 2019 - Türkçe 64bit
Altın Üyelik Bitiş Tarihi
02-09-2027
iyi akşamlar, biraz eksik anlattım sanırım CheckBoxı tıkladığım zamanda aşağıdaki gibi hücrelere değeri yazması gerekiyor. nasıl yapabiliriz.

Private Sub CheckBox1_Click()
Range("G8").Value = "0"
If CheckBox1.Value = True Then
Range("G8").Value = 0.3
Else
End If
End Sub

Private Sub CheckBox2_Click()
Range("H8").Value = "0"
If CheckBox2.Value = True Then
Range("H8").Value = 0.5
Else
End If
End Sub
 
Orion1

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Öyle olmuyor maalesef.
Bilmiyorum belkide ben yapamadım.
Ya ilk yazdığım kodları yada bu sizin yazdığınız oluyor.:cool:
 
Ö

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
12,997
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Altın Üyelik Bitiş Tarihi
(18.03.2020) - Uzman olduğu için tarih geçersiz oldu.
Merhaba.

Sayın @sinnernekolens 'in açtığı başka bir konu sayfasında benzer bir soruyu cevaplamıştım ama yine de çözüm önerimi vereyim.
Sayfanın kod bölümündeki tüm kodları silip aşağıdakileri yapıştırarak deneyin. (A1 hücresi yardımcı olarak kullanılıyor)
.
Rich (BB code): 
Private Sub Worksheet_Change(ByVal Target As Range)
If [A1] = 1 Then Exit Sub
If Intersect(Target, [G8:H8]) Is Nothing Then Exit Sub

If Target.Address(0, 0) = "G8" And Target > 0 Then CheckBox1.Value = True
    If Target.Address(0, 0) = "G8" And Target = 0 Then CheckBox1.Value = False
If Target.Address(0, 0) = "H8" And Target > 0 Then CheckBox2.Value = True
    If Target.Address(0, 0) = "H8" And Target = 0 Then CheckBox2.Value = False
End Sub

Private Sub CheckBox1_Click()
If [A1] = 1 Then Exit Sub
[A1] = 1
    If CheckBox1.Value = True Then Range("G8").Value = 0.3
    If CheckBox1.Value = False Then Range("G8").Value = 0
[A1] = 0
End Sub

Private Sub CheckBox2_Click()
If [A1] = 1 Then Exit Sub
[A1] = 1
    If CheckBox2.Value = True Then Range("H8").Value = 0.5
    If CheckBox2.Value = False Then Range("H8").Value = 0
[A1] = 0
End Sub
 
Son düzenleme:
sinnernekolens

sinnernekolens

Altın Üye
Katılım
23 Temmuz 2009
Mesajlar
310
Excel Vers. ve Dili
Ofis 2019 - Türkçe 64bit
Altın Üyelik Bitiş Tarihi
02-09-2027
Ömer bey tam nokta atışı yaptınız, olmasını istediğim buydu :) aşağıdaki kodu benim Private Sub Worksheet_Change(ByVal Target As Range) nasıl entegre edebilirim?

Private Sub Worksheet_Change(ByVal Target As Range)
If [A1] = 1 Then Exit Sub
If Intersect(Target, [G8:H8]) Is Nothing Then Exit Sub

If Target.Address(0, 0) = "G8" And Target > 0 Then ActiveSheet.CheckBox1.Value = True
If Target.Address(0, 0) = "G8" And Target = 0 Then ActiveSheet.CheckBox1.Value = False
If Target.Address(0, 0) = "H8" And Target > 0 Then ActiveSheet.CheckBox2.Value = True
If Target.Address(0, 0) = "H8" And Target = 0 Then ActiveSheet.CheckBox2.Value = False
End Sub

Yukarıdaki kodu bu koda nasıl entegre edebilirim.
Private Sub Worksheet_Change(ByVal Target As Range) 'ARA GETİR
If Intersect(Target, [P14]) Is Nothing Then Exit Sub
son = Sheets("veri").Cells(Rows.Count, "A").End(3).Row
If WorksheetFunction.CountIf(Sheets("veri").Range("A2:A" & son), Target) = 0 Then
MsgBox "Dosya No sistemde kayıtlı değildir!" & Chr(10) & "" & Chr(10) & "Lütfen bilgileri girdikten sonra kaydet butonuna basınız.", vbInformation, "U Y A R I"
Exit Sub

GoTo 10
End If
[P11] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 2, 0)
[B1] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 3, 0)
[G3] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 4, 0)
[G4] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 5, 0)
[G5] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 6, 0)
[G6] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 7, 0)
[G7] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 8, 0)
[G8] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 9, 0)
[G9] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 10, 0)
[G10] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 11, 0)
[G11] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 12, 0)
[G12] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 13, 0)
[B17] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 14, 0)
[B18] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 15, 0)
[B19] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 16, 0)
[B20] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 17, 0)
[B21] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 18, 0)
[B22] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 19, 0)
[B23] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 20, 0)
[B24] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 21, 0)
[B25] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 22, 0)
[B26] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 23, 0)
[B27] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 24, 0)
[B28] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 25, 0)
[B29] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 26, 0)
[C15] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 27, 0)
[C16] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 28, 0)
[C22] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 29, 0)
[C30] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 30, 0)
[C31] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 31, 0)
[C32] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 32, 0)
[C33] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 33, 0)
[C34] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 34, 0)
[C35] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 35, 0)
[C36] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 36, 0)
[C37] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 37, 0)
[C38] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 38, 0)
[C39] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 39, 0)
[C40] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 40, 0)
[I22] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 41, 0)
[I24] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 42, 0)
[I26] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 43, 0)
[I28] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 44, 0)
[Q30] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 45, 0)
[Q31] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 46, 0)
[Q32] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 47, 0)
[Q33] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 48, 0)
[Q34] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 49, 0)
[Q35] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 50, 0)
[Q36] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 51, 0)
[Q37] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 52, 0)
[Q38] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 53, 0)
[Q39] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 54, 0)
[Q40] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 55, 0)
[Y4] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 56, 0)
[Y5] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 57, 0)
[V13] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 58, 0)
[R3] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 59, 0)
[S3] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 20, 0)
[R2] = WorksheetFunction.VLookup(Target, Sheets("veri").Range("A2:BJ" & son), 61, 0)
10:
End Sub
 
Ö

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
12,997
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Altın Üyelik Bitiş Tarihi
(18.03.2020) - Uzman olduğu için tarih geçersiz oldu.
Bu kodlar, daha evvel açtığınız ve benim, bu konuya cevap yazmadan önce cevap yazdığım,
"CheckBox Sorunu" başlıklı konu sayfasına sorunun
(kayıt/bilgi çağırmada checkboxların işaret durumlarının da getirilmesi)
çözülmüş halini içeren örnek belge eklediğim belgedeki kodlar.

Açtığınız "ChecBox Sorunu" başlıklı konuya fareyle BURAYA tıklayarak erişebilirsiniz.
Son cevap ekindeki belgeyi inceleyeniz/deneyiniz.
.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst