+ ve - makro ile nasıl yazdırabilirim?

[alikaplan]

arkadaşlar ekdeki çalışmamda c2 sütünundan başlayıp en on son hücre ve satıra kadar farenin sol tuşuna 1 kere bastığım zaman + iki kere tıkladığım zaman - yazmasını istiyorum makro ile nasıl yapabilirim şimdiden teşekküler

 

[Mehmet Şahin]

Merhaba,
sayfanızın kod bölümüne kodları kopyalayıp deneyiniz. Kolay gelsin.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
      a = Target.Column
      If a <> 3 Then Exit Sub
      Target.Cells.Value = "+"
      Target.Cells.Offset(1, 0).Select
      
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
      If Target.Count > 1 Then Exit Sub
      a = Target.Column
      If a <> 3 Then Exit Sub
      Target.Cells.Value = "-"
End Sub

 

[alikaplan]

Merhaba,
sayfanızın kod bölümüne kodları kopyalayıp deneyiniz. Kolay gelsin.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
      a = Target.Column
      If a <> 3 Then Exit Sub
      Target.Cells.Value = "+"
      Target.Cells.Offset(1, 0).Select
      
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
      If Target.Count > 1 Then Exit Sub
      a = Target.Column
      If a <> 3 Then Exit Sub
      Target.Cells.Value = "-"
End Sub

teşekküler ama sadece c2 oluyor tüm sütünları nasıl ayarlayabilirim?

 

[Ömer]

Merhaba,

Bende birşeyler karalamıştım, boşa gitmesin. Alternatif olarak kullanabilirsiniz.

Yalnız "+" "-" işaretlerini, Sayın dentex'in kod yapısındakinin tersi olarak algıladım.

Option Explicit
Dim aLan As Range
 
[COLOR=green]' * Hücre seçilince  "+" işareti eklenir.[/COLOR]
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
    Set aLan = Range(Cells(2, 3), Cells(Rows.Count, Columns.Count))
 
    If Intersect(Target, aLan) Is Nothing Then Exit Sub
    If Selection.Cells.Count > 1 Then Exit Sub
 
    Target = "+"
 
End Sub
 
[COLOR=green]'------------------------------------------------------------------- [/COLOR]
[COLOR=green]' * Hücreye çift tıklama yapılırsa "-" işareti eklenir.[/COLOR]
[COLOR=green]' * Çift tıklamalar da kod sizi 1 saniye bekletecektir.[/COLOR]
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
                                        Cancel As Boolean)
 
    If Intersect(Target, aLan) Is Nothing Then Exit Sub
 
    Target = "-"
 
    Application.Wait Now + TimeValue("00:00:01")
    SendKeys "{ESC}"
 
End Sub

.

 

[Mehmet Şahin]

Merhaba,
kodlar çalışıyor, sorun yok. Ayrıca sayın Ömer beyin kodları daha mantıklı. Ben çift tıklamanın sonucundan kaçabilmek için başka hücreyi seçtim. Ömer bey ise çok daha mantıklı bir çözüm sunmuş. Ancak "+" ve "-" işaretlerimiz tam tersi.