Tıklayınca işaretle

[mavi674]

Selam Değerli hocalarım
Aşağıdaki kod A Sütunundaki herhangi dolu hücreye tıklayınca yanındaki (B sütunu) hücresine "X" koyuyor.
İsteğim tekrar aynı hücreye tıklanınca koyduğu "X" silinsin..
Teşekkürler

Private Sub worksheet_selectionchange(ByVal target As Range)
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("sayfa7")
If Not Intersect(target, ws.Range("a:a")) Is Nothing Then
If target.Value <> "" Then
ws.Cells(target.Row, 2).Value = "x"
End If
End If
End Sub

 

[ÖmerBey]

Merhaba,
İlgili satırı aşağıdaki gibi değiştirin.

ws.Cells(target.Row, 2).Value = IIf(ws.Cells(target.Row, 2).Value = "x", "", "x")

 

[mavi674]

Ömer Bey Hocam
teşekkürlerimi sunarım. sağ olun var olun.
Tam istediğim gibi oldu...

 

[ÖmerBey]

Sizler de sağ olun,
İyi çalışmalar...

 

[mavi674]

Tekrar herkese selamlar
ÖmerBey hocamın düzenlediği kodu kendi tabloma uyarlayıp kullanıyorum.
Son durum aşağıdaki kod.
Kullandıkça ihtiyaçlar artıyor veya değişiyor.
Bu aşağıdaki koda şu isteklerimi ekliyebilir miyiz?
A1:A2 hücre değeri değişince MAKRO1
B1:B2 hücre değeri değişince MAKRO2
C1:C2 hücre değeri değişince MAKRO3 çalışsın. Bir de:
J5:J100 arası tıklanınca o hücre kopyalansın.
Şimdiden Teşekkürler....

Private Sub worksheet_selectionchange(ByVal target As Range)
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("sayfa4")
If Intersect(target, Range("k5:k100")) Is Nothing Then Exit Sub
If target.Value <> "" Then
ws.Cells(target.Row, 12).Value = IIf(ws.Cells(target.Row, 12).Value = "x", "", "x")
End If
Range("k1").Select
'target.Copy
End Sub

 

[Muzaffer Ali]

Merhaba.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A1:A2")) Is Nothing Then
        makro1
    ElseIf Not Intersect(Target, Range("B1:B2")) Is Nothing Then
        makro2
    ElseIf Not Intersect(Target, Range("C1:C2")) Is Nothing Then
        makro3
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("sayfa4")
    If Not Intersect(Target, Range("K5:K100")) Is Nothing Then
        If Target.Value <> "" Then
            ws.Cells(Target.Row, 12).Value = IIf(ws.Cells(Target.Row, 12).Value = "x", "", "x")
        End If
        Range("k1").Select
    ElseIf Not Intersect(Target, Range("J5:J10")) Is Nothing Then
        Target.Copy
    End If
End Sub

 

[mavi674]

Selam Muzaffer hocam
süpersiniz...
Mükemmel olmuş tam istediğim gibi, ellerinize sağlık.
Ben
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
başlık altında olacak diye düşünmüştüm.
Oysa
Private Sub Worksheet_Change(ByVal Target As Range)
varmış. Sayenizde çok bilgi sahibi oldum.
Teşekkürlerimi sunuyorum...

 

[Muzaffer Ali]

Bu bir hücre seçince otomatik çalışır.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Bu bir hücre içeriği değiştirilince otomatik çalışır.
Private Sub Worksheet_Change(ByVal Target As Range)

 

[mavi674]

Anladım ve öğrendim artık
notumu alıyorum..
Sayenizde çok şeyler öğrendim,
İyi ki varsınız
Başarılar...

 

[mavi674]

Selam Muzaffer hocam ve diğer hocalarım,
Kodlar çok iyi çalışıyor. Kullandıkça bir şeyler daha ihtiyaç oluyor.

If Not Intersect(Target, Range("A1:A2")) Is Nothing Then
makro1

Bu şekilde makronun çalışmasını sağlamıştık ama gördüm ki liste boş iken de makro gereksiz çalışıyor.
Acaba buna şart eklesek de dolu olduğu zaman çalışsa daha da süper olacak.
If Not Intersect(Target, Range("A1:A2")) Is Nothing Then
eğer Q2 hücresi >=1 olursa çalşısın.
daha dengeli ve mantıklı çalışacak.
Teşekkürlerimi sunuyorum, iyi günler....

 

[Muzaffer Ali]

makro1 yerine bu satırı ekleyin.

if range("Q2") >=1 then makro1

 

[mavi674]

Muzaffer hocam,
elinize sağlık sayenizde mükemmel oldu.
Gerçekten insana keyif veriyor.
İstediğin gibi çalışması çok güzel bir şey.
Tekrar Teşekkürlerimi sunuyorum, iyi günler....