Hücredeki sayıyı "+" ve "-" butonları ile arttırıp azaltma

[stugcu]

Selamlar,

Resimde görüldüğü üzere, + tıklandığında yanındaki sayıyı arttırmalı, - tıklandığında yanındaki sayıyı eksiltmeli.

Bu şekilde bir formül mümkün müdür? Ya da nasıl yapılabilir?

Teşekkürler.

 

[kan-nas]

Artıların ve eksilerin oraya oraya buton ekle. C9 için aşağıdaki gibi. diğerlerinide eklersin.

Sub Button5_Click()
Range("c9") = Range("c9") - 1
End Sub

Sub Button6_Click()
Range("c9") = Range("c9") + 1
End Sub

Yada Spinner Button ekle o da olur.

 

[Merhum İdris SERDAR]

Selamlar,

Resimde görüldüğü üzere, + tıklandığında yanındaki sayıyı arttırmalı, - tıklandığında yanındaki sayıyı eksiltmeli.

Bu şekilde bir formül mümkün müdür? Ya da nasıl yapılabilir?

Teşekkürler.

.

Dosyanız ekte.

.

 

[YUSUF44]

Aşağıdaki kodları sayfanın kod sayfasına yapıştırırsanız arttırma işlemini hücreye tıklayınca yapabilir ancak eksiltme işlemini uyarlayamadım maalesef. (Kodlar sayın Ömer'den alıntıdır)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
    If Intersect(Target, [B9:B11,E9:E11,H9:H11]) Is Nothing Then Exit Sub
 
    With Target
        .Offset(0, 1) = .Offset(0, 1) + 1
    End With
End Sub

eksiltme için de kodlara şöyle bir ilave yaptım ama if olayını doğru yapamadım sanıyorum:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Target, [B9:B11,E9:E11,H9:H11]) Is Nothing Then Exit Sub
 
    With Target
        .Offset(0, 1) = .Offset(0, 1) + 1
    End With
 
   If Intersect(Target, [d9:d11,g9:g11,j9:j11]) Is Nothing Then Exit Sub
 
    With Target
        .Offset(0, -1) = .Offset(0, -1) - 1
    End With
    
End Sub

 

[stugcu]

Değerli arkadaşlar, sayın üstatlar,

Gösterdiğiniz yardımseverlik örneği gerçekten etkileyici, bunun için can-ı gönülden teşekkürler. Asıl dosyayı ekte gönderiyorum. Yurttaş üstadın düzenlediği dosyadaki makro çok işimi gördü. Lakin bu şehirlerden toplam 227 tane mevcut ve her birinin de 17 veri alanı mevcut. Şimdi aklıma şöyle bir şey geldi, acaba ilk alanı açılır liste gibi yapsak, açılan listeden şehri seçtiğimizde sadece onun veri girişi ile ilgili satırlar ekrana gelse, ve ayrıca Yurttaş üstadın eklediği makroyu her veri hücresinin kenarındaki alanlara kopyalasak, böyle bir formül var mıdır yoksa manuel mi yapmak gerekir?

Dosya URL: http://www.matmazzel.com/kisisel/LCV-Dagilimlari-2012.xlsx

 

[YUSUF44]

Değerli arkadaşlar, sayın üstatlar,

Gösterdiğiniz yardımseverlik örneği gerçekten etkileyici, bunun için can-ı gönülden teşekkürler. Asıl dosyayı ekte gönderiyorum. Yurttaş üstadın düzenlediği dosyadaki makro çok işimi gördü. Lakin bu şehirlerden toplam 227 tane mevcut ve her birinin de 17 veri alanı mevcut. Şimdi aklıma şöyle bir şey geldi, acaba ilk alanı açılır liste gibi yapsak, açılan listeden şehri seçtiğimizde sadece onun veri girişi ile ilgili satırlar ekrana gelse, ve ayrıca Yurttaş üstadın eklediği makroyu her veri hücresinin kenarındaki alanlara kopyalasak, böyle bir formül var mıdır yoksa manuel mi yapmak gerekir?

Dosya URL: http://www.matmazzel.com/kisisel/LCV-Dagilimlari-2012.xlsx

Sayın yurttaş'ın dosyasında herhangi bir makro yok. Değer değiştiriciyle yapmış. Belirttiğiniz gibi 200 küsür şehir varsa her şehir için o değer değiştiricileri eklemek ve ayarlamaları yapmanız gerekiyor.

Sayın Ömer'den aldığım kodlara eksiltme işlemini de uyarlayabilsek en ideal çözüm benim verdiğim kodla oluyor ama ona da bir türlü eksiltme işlemini uygulayamadım.

 

[YUSUF44]

Çok şükür biraz uğraşınca kodları şu hale getirdim ve çalıştı:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Target, [B9:B11,E9:E11,H9:H11]) Is Nothing Then
     If Intersect(Target, [d9:d11,g9:g11,j9:j11]) Is Nothing Then Exit Sub
 
    With Target
        .Offset(0, -1) = .Offset(0, -1) - 1
    End With
 Else
    With Target
        .Offset(0, 1) = .Offset(0, 1) + 1
    End With
 End If
  
    
End Sub

sizin şehirler 11. satırda değil de örneğin 50. satırda bitiyorsa kodlardaki 11'leri 50 olarak değiştirmeniz gerekiyor.

 

[Merhum İdris SERDAR]

Değerli arkadaşlar, sayın üstatlar,

Gösterdiğiniz yardımseverlik örneği gerçekten etkileyici, bunun için can-ı gönülden teşekkürler. Asıl dosyayı ekte gönderiyorum. Yurttaş üstadın düzenlediği dosyadaki makro çok işimi gördü. Lakin bu şehirlerden toplam 227 tane mevcut ve her birinin de 17 veri alanı mevcut. Şimdi aklıma şöyle bir şey geldi, acaba ilk alanı açılır liste gibi yapsak, açılan listeden şehri seçtiğimizde sadece onun veri girişi ile ilgili satırlar ekrana gelse, ve ayrıca Yurttaş üstadın eklediği makroyu her veri hücresinin kenarındaki alanlara kopyalasak, böyle bir formül var mıdır yoksa manuel mi yapmak gerekir?

Dosya URL: http://www.matmazzel.com/kisisel/LCV-Dagilimlari-2012.xlsx

.

Her hücreye eklenecekse bunu makro ile yapılması gerekir. Elle yapmak oldukça güç ve zaman alıcı bir şey.

Yapılacak bu spinnerler, hücreye tam sığacak, eşit hizada olacak ve bağlantıları yan hücreler olacak.

Bugün zamanım kalmadı.

Yarın bir çözüm üretebilirim.

.

 

[Merhum İdris SERDAR]

Değerli arkadaşlar, sayın üstatlar,

Gösterdiğiniz yardımseverlik örneği gerçekten etkileyici, bunun için can-ı gönülden teşekkürler. Asıl dosyayı ekte gönderiyorum. Yurttaş üstadın düzenlediği dosyadaki makro çok işimi gördü. Lakin bu şehirlerden toplam 227 tane mevcut ve her birinin de 17 veri alanı mevcut. Şimdi aklıma şöyle bir şey geldi, acaba ilk alanı açılır liste gibi yapsak, açılan listeden şehri seçtiğimizde sadece onun veri girişi ile ilgili satırlar ekrana gelse, ve ayrıca Yurttaş üstadın eklediği makroyu her veri hücresinin kenarındaki alanlara kopyalasak, böyle bir formül var mıdır yoksa manuel mi yapmak gerekir?

Dosya URL: http://www.matmazzel.com/kisisel/LCV-Dagilimlari-2012.xlsx

.

Dosyanız ekte.

.

 

[Macktr]

en son dosyayı bana birisi yollayabilir mi? herşeyi paralı yapmışsınız yahu

 

[Necdet]

en son dosyayı bana birisi yollayabilir mi? herşeyi paralı yapmışsınız yahu

Evet bir sigara parası.

 

[feridici_genc]

Merhaba
2. mesajdaki kodlara bir sayı sınırlandırması yapabilirmiyiz?
en yüksek 38 e kadar en düşük 1 e kadar diye?

 

[feridici_genc]

Kendimce şöyle bir şeyler yapmaya çalıştım fakat tıklama başına hücreyi 2 arttırıyor ve sıfıra gelince durmuyor -1 -2 diye gidiyor.

Sub Button5_Click()
Range("a1") = Range("a1") - 1
If Range("a1") < 0 Then
Range("a1") = 0
Else
End If
Range("a1") = Range("a1") - 1
End Sub

Sub Button6_Click()
Range("a1") = Range("a1") + 1
If Range("a1") > 38 Then
Range("a1") = 38
Else
Range("a1") = Range("a1") + 1
End If
End Sub

 

[feridici_genc]

Deneme yanılma ile buldum.
İyiki de yardım edilmedi öğrenmiş oldum :biggrin:

Sub Button5_Click()
Range("a1") = Range("a1") - 1
If Range("a1") <= 0 Then
Range("a1") = 1
Else
End If
End Sub

Sub Button6_Click()
Range("a1") = Range("a1") + 1
If Range("a1") >= 36 Then
Range("a1") = 36
Else
End If
End Sub

 

[Seyit Tiken]

Bu şekilde daha derli toplu olur.

If [A1] >= 38 Then Exit Sub
[A1] = [A1] + 1

If [A1] <= 0 Then Exit Sub
[A1] = [A1] - 1

 

[feridici_genc]

Uzman eli değmesi ile daha iyi olmuş.
Peki sub başlığı kullanmayacak mıyız?

 

[Seyit Tiken]

Kodu kullandığınız Düğmeye atayınız.

 

[feridici_genc]

Anladım teşekkür ederim.
Seyit bey son bir soru...
Q20 hücresi AR22 ye kadar birleştirilmiş durumda. Bu birleşik hücrenin içinde formül yok ise aşağıdaki kodu çalıştırsa eğer bahsettiğim hücre içinde formül var ise sizin yazdığınız kodu çalıştırsa gibi bir senaryo için bir kod paylaşabilir misiniz?

Hücre içinde formül yoksa bu kod çalışacak

Range("Q20:AR22").Select
    ActiveCell.FormulaR1C1 = _
        "=IFERROR(VLOOKUP(R[-19]C[-16],R[-18]C[44]:R[19]C[45],2,0),"""")"
    Range("Q23").Select

If [A1] >= 38 Then Exit Sub
[A1] = [A1] + 1

Hücrede formül varsa bu kod çalışacak.

If [A1] >= 38 Then Exit Sub
[A1] = [A1] + 1

 

[Seyit Tiken]

Bu şekilde deneyiniz.

If [b1].HasFormula Then
MsgBox "Test"
Else
If [A1] >= 38 Then Exit Sub
[A1] = [A1] + 1
End If