Seçtiğim hücreye X yazmak

[ASLAN7410]

Merhaba hayırlı akşamlar.

Ekte gönderdiğim excel dosyamın Sayfa1'de J5, L5, N5 ve P5 hücrelerinden hangisine tıklarsam o hücreye X yazsın, aynı hücreye tekrar tıkladığımda o hücrenin içerisini silmesini istiyorum.

Bir türlü başaramadım, yardımcı olur musunuz?

 

[ÖmerBey]

Merhaba,
Deneyiniz...

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, [J5,L5,N5,P5,R5]) Is Nothing And Target.Cells.Count = 1 Then
    If Target.Value = "X" Then
        Target.Value = ""
    Else
        Target.Value = "X"
    End If
End If
End Sub

 

[ASLAN7410]

Sayın Ömer Bey, ellerinize sağlık çok teşekkür ediyorum, tam istediğim gibi oldu.

Hayırlı çalışmalar diliyorum.

 

[ÖmerBey]

Rica ederim, iyi çalışmalar...

 

[ASLAN7410]

Sayın Ömer Bey, tekrar rahatsız ediyorum, kodu birleştirilmiş hücrede nasıl çalıştırırım, bu konu da yardımcı olur musunuz?

 

[Ömer BARAN]

Merhaba.

Sayın adaşım çevrimiçi değil.
Kod'u aşağıdaki gibi deneyin.
.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Row = 5 And Target.Column > 9 And sut < 20 Then
    If Range(Split(Target.Address(0, 0), ":")(0)).Value = "X" Then
        Range(Split(Target.Address(0, 0), ":")(0)).Value = ""
    Else: Range(Split(Target.Address(0, 0), ":")(0)).Value = "X"
    End If: End If
End Sub

 

[ASLAN7410]

Sayın Ömer Bey, ilginiz için çok teşekkür ediyorum, ellerinize sağlık, tam isteğim gibi oldu.

Hayırlı geceler diliyorum.

 

[ÖmerBey]

Tekrar merhaba,
İsteğiniz olmuş ama ben yine de alternatif olarak yukarıdaki kodun düzenlenmiş halini paylaşmak istedim, iyi çalışmalar...
Bu arada Sayın Ömer BARAN, yokluğumu hissettirmediğiniz için ayrıca teşekkür ederim.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target.Cells(1), [J5,L5,N5,P5,R5]) Is Nothing Then
    If Target.Cells(1).Value = "X" Then
        Target.Cells(1).Value = ""
    Else
        Target.Cells(1).Value = "X"
    End If
End If
End Sub

 

[ASLAN7410]

Sayın Ömer Bey, size de çok teşekkür ediyorum, bu kodda güzel çalışıyor, ellerinize sağlık.

Hayırlı geceler diliyorum.

 

[tugkan]

Merhaba,
Deneyiniz...

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, [J5,L5,N5,P5,R5]) Is Nothing And Target.Cells.Count = 1 Then
    If Target.Value = "X" Then
        Target.Value = ""
    Else
        Target.Value = "X"
    End If
End If
End Sub

Merhaba Ömer bey,
Bütün sayfaya uygulamak istersek nasıl değiştireceğiz?
İyi çalışmalar

 

[Ömer BARAN]

Merhaba.

Böyle bir işlemde benim tercihim Worksheet_BeforeDoubleClick yapısını kullanmak olurdu.
Aşağıdaki kod blokunu sayfanın kod bölümüne yapıştırırsanız; istediğiniz hücrede,
fareyle boş hücreye çift tıklandığında "X" yazılır, "X" yazılı hücreye fareyle çift tıklamada ise hücrede mevcut "X" değeri silinir.
Hücre boş veya hücre değeri X ise işlem gerçekleşir.
Hücrede "X" dışında bir değer varsa herhangi bir işlem yapılmaz.
Yukarıda belirttiğim hususlar birleştirilmiş hücrelerde de, sorunsuz olarak çalışır.
Deneyiniz.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Cells(1).Value = "X" Then Target.Cells(1).Value = "": GoTo 10
If Target.Cells(1).Value = "" Then Target.Cells(1).Value = "X": GoTo 10
10: Cancel = True
End Sub

 

[tugkan]

Sayın @Ömer BARAN ,
Kod gayet güzel çalışıyor. Teşekkür ederim. Peki son bir soru sorabilir miyim? (en azından şimdilik )
Herhangi bir satıra çift tıkladığımız da o satırı renklendirmek için böyle bir kodunuz var mı?

 

[Ömer BARAN]

Tekrar merhaba.

Sayfanın kod bölümüne aşağıdaki kod blokunu yapıştırın.
-- önce mavi renklendirdiğim satırların sol başına TEK TIRNAK ekleyip o satırları etkisiz kılarak,
-- ardından da kırmızı renklendirdiğim satırların sol başına TEK TIRNAK işareti ekleyip o satırları etkisiz kılarak
hücrelere fareyle çift tıklayıp, sonucu gözlemleyin.

İlk durumda; sadece A4:K20 aralığındaki hücrelere çift tıklandığında işlem yapılır ve
aynı aralıkta kalmak üzere, ilgili tablo satırı ve sütunu renklendirilir,
ikinci durumda ise ilgili hücrenin satır ve sütunu (bütun satır/sütun) renklendirilir.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [A4:K20]) Is Nothing Then Exit Sub
    Range("A4:K20").Interior.Color = xlNone
    Range("A" & Target.Row & ":K" & Target.Row).Interior.ColorIndex = 15
    Range(Cells(4, Target.Column), Cells(20, Target.Column)).Interior.ColorIndex = 15
    Target.Interior.ColorIndex = 6
    Cells.Interior.Color = xlNone
    Rows(Target.Row).Interior.ColorIndex = 15
    Columns(Target.Column).Interior.ColorIndex = 15
    Target.Interior.ColorIndex = 6
Cancel = True
End Sub

 

[tugkan]

Kod tarif ettiğiniz şekilde çalışıyor.

Size sorduğum sırada ben de şöyle bir kod bulmuştum. Tek tıklayarak renklendiriyor.

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Cells.Interior.ColorIndex = xlColorIndexNone
ActiveCell.EntireColumn.Interior.ColorIndex = 19 'Sütun Rengi
ActiveCell.EntireRow.Interior.ColorIndex = 17 ' Satır Rengi
ActiveCell.Cells.Interior.ColorIndex = 4 ' Hücre Rengi
End Sub

Ben aslında renklendirdiğimiz alanın kalıcı olmasını istiyorum. Aynı hücreye X koyduğumuz gibi tek veya çift tıkladığımızda boyayacak (kalıcı olarak)
, tekrar tıkladığımızda dolgu olmadığı haline dönecek.

 

[Ömer BARAN]

Yine tüm satır ve tüm sütun mu?
Eğer isteğiniz öyle ise bana pek anlamlı gelmedi.

 

[tugkan]

Sadece satırı boyamasını istediğimi belirtmemişim haklısınız. Tekrar okuyunca bana da saçma geldi.
İstememde ki amaç : Bizim ürünlerin reçetelerini başka departmanlara gönderirken bazı satırları seçerek boyuyor ve boyadığım satırları silerek gönderiyorum. CTRL ile seçip manuel boyamaktansa, tıklayarak boyamak daha pratik gibime geldi.
Sebebi bu.