Her tık ile bir sayı artan hücre

[erguna]

Arkadaşlar böyle bir kod varmıdır mesela hücrede 5 yazıyor ben tıklayınca veya çift tıklayınca 6 olacak bi daha tıklayınca 7 olacak. Çok lazım 4 saatlik işimi 1 saate indirecek. Yardımlarınız için şimdiden teşekkürler...

 

[Necdet]

Merhaba,

Hücre yada hücrelerin adresleri belli mi? Sadece A1 hücresini 1 arttırı. Ekteki örneği inceleyiniz. Kodlar ilgili sayfanın kod bölümünde olmalı.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
[A1] = [A1] + 1
End Sub

 

[leumruk]

Arkadaşlar böyle bir kod varmıdır mesela hücrede 5 yazıyor ben tıklayınca veya çift tıklayınca 6 olacak bi daha tıklayınca 7 olacak. Çok lazım 4 saatlik işimi 1 saate indirecek. Yardımlarınız için şimdiden teşekkürler...

Sub Dene()
[A1]=[A1]+1
End Sub

 

[N.Ziya Hiçdurmaz]

yanıt

A1 Hücresinde çalışır siz değiştirirsiniz

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [a1]) Is Nothing Then Exit Sub
Target = Target + 1
End Sub

 

[erguna]

arkadaşlar çok yeniyim kusura bakmazsanız bişey daha sorucam "sub - end sub" herhalde komut satırı gibi bir olay buna nasıl giriş yapıyorum?

 

[leumruk]

arkadaşlar çok yeniyim kusura bakmazsanız bişey daha sorucam "sub - end sub" herhalde komut satırı gibi bir olay buna nasıl giriş yapıyorum?

Araçlar>Makro>Visualbasic Düzenleyicisi>İnsert 'ten modül oluşturuyorsunuz. Verilen kodu bu bölüme yapıştırıp düğmeye atıyorsunuz.
Ziya Bey'in kod sistemi daha farklı. Bu kodu İnsert yerine geçerli sayfanın kod bölümüne kopyalayacaksınız. Mesela; yukarıda verdiğim şekilde ilerliyorsunuz, modül oluşturmak yerine solda görünen sayfa isimlerine tıklayıp içine kopyalıyorsunuz.
Benim verdiğim kod düğme aracılığıyla çalışır. Ziya Bey'in verdiği hücre içine çift tıkladığınızda çalışır.
Örnek bir dosya ekliyorum. Her iki kodda içinde yerleştirilmiş durumda. A1 düğmeyle çalışır. C1'in çalışması için hücre içine girmeniz gerekli. Deneyerek daha iyi anlayabilirsiniz.

 

[erguna]

çok teşekkür ettim hocam...

 

[leumruk]

çok teşekkür ettim hocam...

Rica ederim.

 

[erguna]

A1 Hücresinde çalışır siz değiştirirsiniz

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [a1]) Is Nothing Then Exit Sub
Target = Target + 1
End Sub

Üstadlarım bişey sormak istiyorum müsadeniz ile. Sayenizde tam istediğim hücreye sahip oldum. Şu anki sorunum ise yukardaki kodu kopyalayamamak. Yani A1 hücresi gibi A2 yide yapmaya çalıştırm kodu aynen kopyalayıp altına yapıştırdım A1 kısmını A2 yaptım olmadı.

Yeni Class Module açıp kodu değiştirip yapıştırdım sanırım isim problemi var dedi. Nedir ne değildir bir yardımcı olursanız çok memnun olurum...

 

[Orion1]

Üstadlarım bişey sormak istiyorum müsadeniz ile. Sayenizde tam istediğim hücreye sahip oldum. Şu anki sorunum ise yukardaki kodu kopyalayamamak. Yani A1 hücresi gibi A2 yide yapmaya çalıştırm kodu aynen kopyalayıp altına yapıştırdım A1 kısmını A2 yaptım olmadı.

Yeni Class Module açıp kodu değiştirip yapıştırdım sanırım isim problemi var dedi. Nedir ne değildir bir yardımcı olursanız çok memnun olurum...

Kodun ilgili yerini aşağıdaki ile değiştiriniz.

If Intersect(Target, [a1[B][COLOR="Red"]:A2[/COLOR][/B]]) Is Nothing Then Exit Sub

 

[leumruk]

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [a1:f1]) Is Nothing Then Exit Sub
If ActiveCell = [a1] Then [a1] = [a1] + 1
If ActiveCell = [b1] Then [b1] = [b1] + 1
If ActiveCell = [c1] Then [c1] = [c1] + 1
If ActiveCell = [d1] Then [d1] = [d1] + 1
If ActiveCell = [e1] Then [e1] = [e1] + 1
If ActiveCell = [f1] Then [f1] = [f1] + 1
End Sub

Kodu dener misiniz? 6 hücrede uyguladım. İlk satırdaki aralığı geneişleterek aynı formatla istediğiniz kadar yapabilirsiniz.

 

[erguna]

Kodun ilgili yerini aşağıdaki ile değiştiriniz.

If Intersect(Target, [a1[B][COLOR="Red"]:A2[/COLOR][/B]]) Is Nothing Then Exit Sub

Hocam bu kod sorunumu çözdü fakat bi noktadan sonra hücre ekleyemiyorum "Identifier too long" hatası alıyorum bunu nasıl aşabilirim?

 

[erguna]

Arkadaşlar bu kodlarla uğraşırken fazla zamanım kalmadı biraz sıkıştım yukarıdaki sorun ile ilgili fikri olan varmı?

 

[leumruk]

Arkadaşlar bu kodlarla uğraşırken fazla zamanım kalmadı biraz sıkıştım yukarıdaki sorun ile ilgili fikri olan varmı?

Eklemek istediğiniz kadar aralığı genişletmeniz gerekir. A1:A2'yi A1:A20 yaparsanız. Aynı işlemi 20 hücreye kadar yaparsınız. Bu haliyle sadece iki hücrede gerçekleştirebilirsiniz.

 

[erguna]

Çok teşekkürler hocam varol...

 

[leumruk]

Çok teşekkürler hocam varol...

Rica ederim.