Soru Açılır Liste Seçimine Göre Hücreye Kural Atanması

[Akinet10]

"Kategoriler" sayfasında mesela;
"Yakıt" kalemi "Gider" olarak; "Satış" kalemi "Gelir" olarak açılır liste kaydedilsin.

"İşlemler" sayfama yakıt işleyip, açılır hücreden "Gider" seçtiğimde E sütunundaki hücre değeri negatif para olmak zorunda,
ayrıca Satış işlerken "Gelir" seçtiğimde de pozitif değer olmak zorunda.

Nasıl bir yol izlemeliyim?

 

[YUSUF44]

Öncelikle örnek dosya paylaşmakla başlayabilirsiniz.

 

[Akinet10]

https://s4.dosya.tc/server9/zuujz3/YillikRapor.xlsx.html
Örnek Dosya

 

[Akinet10]

=EĞER(VE(E3>0;EĞER(KAÇINCI(B3;Kategoriler!B$2:B$28;0);YANLIŞ));YANLIŞ;DOĞRU)

böyle birşey buldum, hatalı ama saçma mı?

 

[YUSUF44]

Aşağıdaki kodları İşlemler sayfasını kod bölümüne (sayfa adına sağ tıklayıp kod görüntüle deyince açılan sayfaya) yapıştırırsanız Tutar bölümüne veri girdiğinizde istediğiniz şekilde negatif ya da pozitif olarak yazılır. Kategoriler sayfasında yapmak istediğiniz işlemi anlayamadım.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E2:E6]) Is Nothing Then Exit Sub
Set s1 = Sheets("Kategoriler")
son = s1.Cells(Rows.Count, "b").End(3).Row
If Target.Offset(0, -3) = "" Then
    MsgBox "Önce Kategori seçiniz", vbCritical
    Target = ""
    Target.Offset(0, -3).Select
ElseIf WorksheetFunction.CountIf(s1.Range("B1:B" & son), Target.Offset(0, -3)) = 0 Then
    MsgBox "Girilen kategori Kategoriler sayfasında bulunmamaktadır!", vbCritical
    Target = ""
    Target.Offset(0, -3).Select
ElseIf WorksheetFunction.VLookup(Target.Offset(0, -3), s1.Range("B1:C" & son), 2, 0) = "Gelir" Then
    Application.EnableEvents = False
        Target = Abs(Target)
    Application.EnableEvents = True
ElseIf WorksheetFunction.VLookup(Target.Offset(0, -3), s1.Range("B1:C" & son), 2, 0) = "Gider" Then
    Application.EnableEvents = False
        Target = Abs(Target) * (-1)
    Application.EnableEvents = True
End If
    
End Sub

 

[Akinet10]

Gayet güzel üstad. Yalnız kategori seçmeden rakam yazarsam açılan hata mesajından kurtulamıyorum, tekrarlıyor ve işlem yaptırmıyor. Nasıl aşabiliriz? Mesaj bir kere görünse veya mesela Mesajda "tamam"a basınca yazılan rakam silinse mi acaba?

Bir de listem birkaç yüz sayfa olacak, "If Intersect(Target, [E2:E6]) " satırında E6 yı değiştirsem yetecektir değil mi?

 

[serdar.gul]

Akinet,

dosya linki

YillikRapor.xlsx dosyasını indir - download

YillikRapor.xlsx dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s4.dosya.tc

 

[YUSUF44]

Aşağıdaki gibi dener misiniz?

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E2:E600]) Is Nothing Then Exit Sub
Set s1 = Sheets("Kategoriler")
son = s1.Cells(Rows.Count, "b").End(3).Row
Application.EnableEvents = False
    If Target.Offset(0, -3) = "" Then
        MsgBox "Önce Kategori seçiniz", vbCritical
        Target = ""
        Target.Offset(0, -3).Select
    ElseIf WorksheetFunction.CountIf(s1.Range("B1:B" & son), Target.Offset(0, -3)) = 0 Then
        MsgBox "Girilen kategori Kategoriler sayfasında bulunmamaktadır!", vbCritical
        Target = ""
        Target.Offset(0, -3).Select
    ElseIf WorksheetFunction.VLookup(Target.Offset(0, -3), s1.Range("B1:C" & son), 2, 0) = "Gelir" Then
            Target = Abs(Target)
    ElseIf WorksheetFunction.VLookup(Target.Offset(0, -3), s1.Range("B1:C" & son), 2, 0) = "Gider" Then
            Target = Abs(Target) * (-1)
    End If
Application.EnableEvents = True
End Sub

Ben 600. satır için yaptım, o kısmı nasıl değiştirirseniz ona göre işlem yapar.