• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

  • Konbuyu başlatan Konbuyu başlatan stugcu
  • Başlangıç tarihi Başlangıç tarihi
S

stugcu

Katılım
7 Ağustos 2011
Mesajlar
9
Excel Vers. ve Dili
MS Office 2010
Ekran_Alıntısı.JPG


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.
 

Ekli dosyalar

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.
 
stugcu' Alıntı:
Ekran_Alıntısı.JPG


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.
Genişletmek için tıkla ...

.

Dosyanız ekte.

.
 

Ekli dosyalar

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)

Kod: 
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:

Kod: 
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
 
Son düzenleme:
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
 
stugcu' Alıntı:
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
Genişletmek için tıkla ...

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.
 
Çok şükür biraz uğraşınca kodları şu hale getirdim ve çalıştı:

Kod: 
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.
 
stugcu' Alıntı:
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
Genişletmek için tıkla ...

.

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.

.
 
stugcu' Alıntı:
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
Genişletmek için tıkla ...

.

Dosyanız ekte.

.
 

Ekli dosyalar

en son dosyayı bana birisi yollayabilir mi? herşeyi paralı yapmışsınız yahu
 
Merhaba
2. mesajdaki kodlara bir sayı sınırlandırması yapabilirmiyiz?
en yüksek 38 e kadar en düşük 1 e kadar diye?
 
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.

Kod: 
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
 
Deneme yanılma ile buldum.
İyiki de yardım edilmedi öğrenmiş oldum :biggrin:

Kod: 
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
 
Bu şekilde daha derli toplu olur.

Kod: 
If [A1] >= 38 Then Exit Sub
[A1] = [A1] + 1
Kod: 
If [A1] <= 0 Then Exit Sub
[A1] = [A1] - 1
 
Uzman eli değmesi ile daha iyi olmuş.
Peki sub başlığı kullanmayacak mıyız?
 
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
Kod: 
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.
Kod: 
If [A1] >= 38 Then Exit Sub
[A1] = [A1] + 1
 
Bu şekilde deneyiniz.
Kod: 
If [b1].HasFormula Then
MsgBox "Test"
Else
If [A1] >= 38 Then Exit Sub
[A1] = [A1] + 1
End If
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst