Hücredeki Sayının Eksi Değerinin Girilmesini önleme

[hergil42]

Arkadaşlar konu başlığı başlığında biraz anlam bozukluğu oldu herhalde şöle bir sorunla karşılaştım ve çözemedim yardımcı olurmusunuz.Yapmak istediğim şu :

a b c d hücrelerinde veriler var ve e-f hücrelerine sayı olarak veri girişi yapılan bir excel çalışma sayfası e ve f hücrelerine sayı değerleri girerken hücredeki sayının aşağı değerini girmesini engelleyen bir kod varmıdır.
örnek :a1 b1 c1 d1 veriler var e1 deki sayı değeri 10 f1 deki 123 ben e1 ve f1 hücrelerine sayı değeri girdiğimde 10 ve 123 üstü değer girmek istiyorum 10 ve 123 aşağısında değer girdiğimde hücrenin içindeki sayı degerini korumasını istiyorum. Bu sayılar sabit değil 0 1 ................. sonsuz şekilde değişebilir. yani hücredeki sayının eksik değerlerini girmemek.İnşallah anlatabilmişimdir. Birörnek daha yazayım örnek :
e ve f hücrelerinde çeşitli sayılar var ben e3 deki 17 sayının üzerine 13 ekleyecem ekleme işlemini formülsüz yapıp 17 değerinin üzerine ekleyip 30 yazacam olurda 13 ü 17 ile toplamayı unuttum direk 13 yazdım işte hücredeki 17 sayısından küçük oldugu için küçük bir uyarı msj verip hücre içindeki 17 sayısını koruyacak bu hücrelerdeki sayılar sabit değil 0 1 ............ diye değişebilir.Yardımlarınız için çok tşk ederim.

 

[Korhan Ayhan]

Selamlar,

Ekteki örnek dosyayı incelermisiniz.

 

[hergil42]

Çok güzel

Korhan bey gerçekten çok mükemmel bir çalışma inanılmaz bir çalışma olmuş. ellerinize saglık çok tşk ederim. Bir ufak sorum daha olacak burda hücrenin değerindeki sayının aşağı bir değer yazamıyoruz istediğimde buydu baska bir çalışma sayfasına bunu kaldırıp sadece hücrenin içindeki değere yeni yazdığımız değeri toplattırmayı nasıl yapabilirim. Örnek a1 hücresinde 150 var ben a1 hücresine 291 daha ekleyecem sonuç 441 olacak bunu nasıl yapabilirim. yardımcı olurmusunuz. Tekrar tekrar çok tşk ederim mükemmel bir çalışma olmuş.Korhan bey birde aklıma geldi örnek dosyayı inceledim a1 hücresinde 100 var oldugunu sayalım 100 e ancak 100 ve üzeri ekleyebliriz ama bir ürün geldiğini farz edelim gelen üründe 50 adet gelsin 100 ün aşağı değerini giremeyizki bunu nasıl çözebiliriz.

 

[Korhan Ayhan]

Selamlar,

Örnek dosyadaki kırmızı renkli satırları silip deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target = "" Then Exit Sub
    Application.EnableEvents = False
[COLOR=red]    If Target < EskiDe&#287;er Then
    MsgBox "&#214;nceki de&#287;erden k&#252;&#231;&#252;k de&#287;er girilemez !", vbCritical, "D&#304;KKAT !"
    Target = EskiDe&#287;er
    Else
[/COLOR]    Target = Target + EskiDe&#287;er
[COLOR=red]    End If[/COLOR]
    Application.EnableEvents = True
End Sub

 

[hergil42]

Olmadı

Denedim olmadı kırmızı yazılı olan yerleri sildim ama toplama yapmadı.

 

[hergil42]

Çok Özür Dilerim.

Kodları eksik kopyaladığımdan dolayı hesaplama yapmadı şimdi yapıyor çok özür dilerim ellerinize saglık gerçekten mükemmel fevkalade bir çalışma işte bu usta diye buna söylenir.Tekrar tşk ler.

 

[hergil42]

Bu kodlar birbirine girdi

Koray bey sayfada kod var bu kodları da ekleyince karıstı hata veriyor kodlar aşağıda

Private Sub Worksheet_Activate()
Range("IV65536").Select
If InputBox("BU SAYFANIN KULLANIM HAKKI KISITLANMIŞTIR", "ŞİFRE GİRİNİZ") = "93219321" Then
Range("A1").Select
Else
MsgBox ("ŞİFRE YANLIŞ")
MsgBox ("BU SAYFAYI KULLANIM YETKİNİZ YOKTUR")
MsgBox ("SORU ve İSTEKLERİNİZ İÇİN ANA SAYFADAKİ MAİL ADRESİ İLE İLETİŞİM KURABİLİRSİNİZ")
Sheets("Sayfa1").Select

sizin kodlarla sayfadi kodları yazınca hata veriyor aşağıdaki gibi yazdım

Private Sub Worksheet_Activate()
Range("IV65536").Select
If InputBox("BU SAYFANIN KULLANIM HAKKI KISITLANMIŞTIR", "ŞİFRE GİRİNİZ") = "93219321" Then
Range("A1").Select
Else
MsgBox ("ŞİFRE YANLIŞ")
MsgBox ("BU SAYFAYI KULLANIM YETKİNİZ YOKTUR")
MsgBox ("SORU ve İSTEKLERİNİZ İÇİN ANA SAYFADAKİ MAİL ADRESİ İLE İLETİŞİM KURABİLİRSİNİZ")
Sheets("Sayfa1").Select
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target = "" Then Exit Sub
Application.EnableEvents = False
Target = Target + EskiDeğer
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Application.ScreenUpdating = True
End Sub



End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Application.ScreenUpdating = True
End Sub

kırmızı yazılı olan yerde hata veriyor.

 

[hergil42]

Kodlar karıştı

Korhan bey benim sayfamda aşağıdaki kodlar var formüllü koşullu biçimlendirmede var seçilen hücre yeşil oluyor. Yalnız sizin kodlarıda sayfaya yazdıgımda işlem yapmıyor düzenlemey çalıştım olmadı. Benim çalışma sayfamdaki kodları aşağıya yazıyorum. Sizin yukarda kırmızı yazılı olanları sildikten sonra geriye kalanları benim kodlarla nasıl bir sayfada toplayıp düzenli çalışmasını saglayabilirim. Benim çalışma sayfasındaki kodlar :

Private Sub Worksheet_Activate()
Range("IV65536").Select
If InputBox("BU SAYFANIN KULLANIM HAKKI KISITLANMIŞTIR", "ŞİFRE GİRİNİZ") = "93219321" Then
Range("A1").Select
Else
MsgBox ("ŞİFRE YANLIŞ")
MsgBox ("BU SAYFAYI KULLANIM YETKİNİZ YOKTUR")
MsgBox ("SORU ve İSTEKLERİNİZ İÇİN ANA SAYFADAKİ MAİL ADRESİ İLE İLETİŞİM KURABİLİRSİNİZ")
Sheets("Sayfa1").Select
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Application.ScreenUpdating = True
End Sub


Bunlar benim sayfadakiler buna ek olarak sizin yukardaki yazdıgınızı nasıl ekleyebilirim.Sizin kodlarınızda aşağıya yazdım.Sizin verdiğiniz kodlar :

Dim EskiDeğer As Variant

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target = "" Then Exit Sub
Application.EnableEvents = False
Target = Target + EskiDeğer
Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
EskiDeğer = Target
End Sub

 

[hergil42]

Kodların Sıralanması

Dim EskiDeğer As Variant

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target = "" Then Exit Sub
Application.EnableEvents = False
Target = Target + EskiDeğer
Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
EskiDeğer = Target
Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Activate()
Range("IV65536").Select
If InputBox("BU SAYFANIN KULLANIM HAKKI KISITLANMIŞTIR", "ŞİFRE GİRİNİZ") = "1" Then
Range("A1").Select
Else
MsgBox ("ŞİFRE YANLIŞ")
MsgBox ("BU SAYFAYI KULLANIM YETKİNİZ YOKTUR")
MsgBox ("SORU ve İSTEKLERİNİZ İÇİN ANA SAYFADAKİ MAİL ADRESİ İLE İLETİŞİM KURABİLİRSİNİZ")
Sheets("Sayfa2").Select
End If
End Sub

yukarıdaki gibi yazıldıgında işlem tamam oluyor. Çok tşk ederim ellerinize sağlık gerçeketen fevkalade bir çalışma oldu.