Çift Tıklayınca Aynı Sayfada Farklı Hücrelerde İki Farklı Sayıyı Arttırmak

[FENERIUM1907]

Slm arkadaşlar çok yeri aradım google de armadığım yer kalmadı ama bulamadım.Benim kullandığım vba kodu alttadır.Ama bu kod sadece tek bir sayfada tek hücreyi ve verilen tek arttırma sayısını artırıyor. Bana ayrıyeten farklı hücrede farklı bir değerde arttırma yaptırması gerek. Aynı kodu tekrar girince aynı sayfaya hata veriyor.Exelde yeni sayılırım biraz daha acık olursa cevaplarınız sevinirim.Şimdi den teşekkürler.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error GoTo Son
If Intersect(Target, [A:A,C:C,F:F]) Is Nothing Then Exit Sub
Cancel = True
Target = Target + 1
If Target.Column = 1 Then Target.Offset(0, 2).Select
If Target.Column = 3 Then Target.Offset(0, 3).Select
If Target.Column = 6 Then Target.Offset(1, 9-5).Select
Exit Sub
Son:
End Sub

 

[Korhan Ayhan]

Selamlar,

Forumumuza hoşgeldiniz.

Siz hangi hücrelere çift tıklayınca hangi hücrelerdeki değerlerin artmasını istiyorsunuz belirtirseniz yardım almanız kolaylaşacaktır.

 

[FENERIUM1907]

Siz hangi hücrelere çift tıklayınca hangi hücrelerdeki değerlerin artmasını istiyorsunuz belirtirseniz yardım almanız kolaylaşacaktır.

ilgilendiğin için saol .Anlatayım a b ve c hücrelerine tıklayın ca en alta kadar "target" deki ddeğeri veriyor o tamam.Yanlız benim istediğim aynı sayfadaki d e f hücrelerine ayrı artırma değeri, ve yine g h ı hücrelerine ayrı çift tıkladığım zaman arttırma değeri vermesini istiyorum.

 

[Korhan Ayhan]

Selamlar,

Yaptığınız açıklamalarınızdan dolayı kafamda çözümü oluşturdum. Fakat netleştirmek için bir örnekle açıklarsanız çözüm için faydalı olacaktır. Mesela A1 hücresine çift tıkladığımızda sonucun ne olması gerekiyor.

 

[FENERIUM1907]

If Intersect(Target, [A:A,C:C,F:F]) Is Nothing Then Exit Sub
Cancel = True
Target = Target + 1

target yazan yerdeki değerin çift tıklatınca otomatik yazmasını istiyorum ama daha önce de yazdığım gibi diger aynı sayfadaki hücrelere de farklı değerde yazacagım target ile arttırma yapmasını istiyorum

 

[Korhan Ayhan]

Selamlar,

Umarım isteğinizi doğru anlamışımdır. Aşağıdaki kodu denermisiniz. Kırmızı eklenti yapılmıştır. Eğer isteğinizi karşılamıyorsa lütfen örnek dosya ekleyerek açıklama yapınız.

Option Explicit
 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    On Error GoTo Son
    If Intersect(Target, [A:A,C:C,F:F]) Is Nothing Then Exit Sub
    Cancel = True
    Target = Target + 1
[COLOR=red]    Range("E1") = Range("E1") + 1
[/COLOR]    If Target.Column = 1 Then Target.Offset(0, 2).Select
    If Target.Column = 3 Then Target.Offset(0, 3).Select
    If Target.Column = 6 Then Target.Offset(1, 9 - 5).Select
    Exit Sub
Son:
End Sub

 

[FENERIUM1907]

Option Explicit
 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    On Error GoTo Son
    If Intersect(Target, [A:A,C:C,F:F]) Is Nothing Then Exit Sub
    Cancel = True
    Target = Target + 1
[COLOR=red]    Range("E1") = Range("E1") + 1
[/COLOR]    If Target.Column = 1 Then Target.Offset(0, 2).Select
    If Target.Column = 3 Then Target.Offset(0, 3).Select
    If Target.Column = 6 Then Target.Offset(1, 9 - 5).Select
    Exit Sub
Son:
End Sub

[/QUOTE]


şu an işyeri yoğun olduğu için hazırlayamadım örnek dosya ama şöyle anlatayım galiba yanlış anlasıldım

1.aynı sayfada farklı hücreler üzerinde,
2.birbirinden bagımzız bir sekilde çift tıklatınca artacak,
3.aynı sayfada farklı rakamlarda farklı hücraleri tıklayın ca arttırma yapabilecek.
yani çift tıklatınca a1 2 ser artıyorsa b1 4 er artacak c1 5er artacakİ; sizin göndermiş oldugunuzda birbiri ile baglantılı artış yapmaktadır.kac gündür arastırıorum bi care bulamadık gittii

 

[Korhan Ayhan]

Selamlar,

Evet sanıyorum ifadeleriniz eksik oldu. Ama son mesajınızda ne demek istediğinizi gayet iyi anladım. Aşağıdaki kodu kullanabilirsiniz.

Kod şu mantıkla çalışır;

A sütununda çift tıkladığınızda ilgili hücreye +2 ekler.
C sütununda çift tıkladığınızda ilgili hücreye +4 ekler.
F sütununda çift tıkladığınızda ilgili hücreye +5 ekler.

Option Explicit
 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    On Error GoTo Son
    If Intersect(Target, Range("A:A,C:C,F:F")) Is Nothing Then Exit Sub
    Cancel = True
    Select Case Target.Column
        Case Is = 1
        Target = Target + 2
        Case Is = 3
        Target = Target + 4
        Case Is = 6
        Target = Target + 5
    End Select
Son:
End Sub

 

[FENERIUM1907]

Korhan bey çok tesekkür ediorum allah sizden razı olsun kac günlerdir aradıgım seyi sayenizde buldum ii çalışmalar..