KOD İLE ÇOKLU HESAPLAMA

ulutanas

Altın Üye
Katılım
8 Kasım 2008
Mesajlar
578
Excel Vers. ve Dili
Excel Vers. ve Dili Ofis 2021 TR 32 Bit
Arkadaşlar tekrardan merhaba, yine takıldığım 4 sorulu bir sorunum var açıklamalar ekli dosyada mevcut, personellerin bozduğu hücre kodunu düzeltmekten bıktım ama onlar bozmaktan bıkmadı. Basit ama takıldığım yerlerde yarımcı olursanız çok memnun olurum, şimdiden bütün arkadaşlara teşekkür ederim.
İyi çalışmalar,
Saygılarımla...
 

Ekli dosyalar

ulutanas

Altın Üye
Katılım
8 Kasım 2008
Mesajlar
578
Excel Vers. ve Dili
Excel Vers. ve Dili Ofis 2021 TR 32 Bit
Günaydın hayırlı günler arkadaşlar,
konuya bakan an itibariyle ile 43 kişi teşekkürler arkadaşlar, sonuçta bugün çıkar inşallah. :)
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Kodlarınızda hep exit sub kullandığınız için o şart sağlanmadığında yani ilk target gerçekleşmediğinde kodlardan çıkış yapılıyor, diğer targetlerle ilgili satırlara bakılmıyor. Farklı alanlardaki sayfa olayları için aşağıda verdiğim düzende kod kullanılmalıdır.

Eski kodlarınız yerine aşağıdaki kodları deneyiniz:

PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
a = Target.Row
If Selection.Count > 1 Then Exit Sub
If Intersect(Target, [B5:C200]) Is Nothing Then GoTo 10
    If IsDate(Cells(a, "C")) And IsDate(Cells(a, "B")) Then
        If Cells(a, "C") = WorksheetFunction.EoMonth(Target, 0) Then
            Cells(a, "E") = Cells(a, "C") - Cells(a, "B") + 1
        Else
            Cells(a, "E").ClearContents
        End If
    Else
        Cells(a, "E").ClearContents
    End If
10:
If Intersect(Target, [F5:H200]) Is Nothing Then GoTo 20
    If IsNumeric(Target) Then
        Cells(a, "I") = Cells(a, "F") * Cells(a, "G") + Cells(a, "G") * Cells(a, "H")
        If IsNumeric(Cells(a, "J")) Then
            Cells(a, "K") = Round(Cells(a, "I") * Cells(a, "J"), 2)
            Cells(a, "L") = Cells(a, "I") + Cells(a, "K")
        End If
    Else
        MsgBox "F, G ve H sütununlarıa sadece tutar girebilirsiniz!", vbInformation
        Target.Select
        Target.ClearContents
        Cells(a, "I").ClearContents
    End If
20:
If Intersect(Target, [J5:J200]) Is Nothing Then GoTo 30
    If IsNumeric(Cells(a, "J")) And IsNumeric(Cells(a, "H")) Then
        Cells(a, "K") = Round(Cells(a, "I") * Cells(a, "J"), 2)
        Cells(a, "L") = Cells(a, "I") + Cells(a, "K")
    Else
        MsgBox "J sütununa sadece sayısal olarak KDV oranı girebilirsiniz!", vbInformation
        Target.Select
        Target.ClearContents
        Cells(a, "K").ClearContents
        Cells(a, "L").ClearContents
    End If
30:
If Intersect(Target, [M5:M200]) Is Nothing Then Exit Sub
    If IsNumeric(Cells(a, "L")) And IsNumeric(Cells(a, "M")) Then
        Cells(a, "N") = Cells(a, "L") - Cells(a, "M")
    Else
        MsgBox "L sütununa sadece ödenen tutar girebilirsiniz!", vbInformation
        Target.Select
        Target.ClearContents
        Cells(a, "N").ClearContents
    End If
End Sub
 

ulutanas

Altın Üye
Katılım
8 Kasım 2008
Mesajlar
578
Excel Vers. ve Dili
Excel Vers. ve Dili Ofis 2021 TR 32 Bit
Yusuf hocam emeğinize sağlık çok teşekkür ederim, lakin 2 sorun gördüm.
Size zahmet olmazsa tekrar yardım ederseniz çok sevinirim.

1. Sorun) B ve C sütunlarına girdiğim tarihler her gün için değil aylık sonuç veriyor. Yani 01.07.2020 - 31.07.2020 dediğim zaman E sütununda 31 gün gösteriyor bu doğru sonuç, lakin 30/07/2020 veya daha farklı bir tarih girdiğim zaman sonuç göstermiyor.

2. Sorun) N sütununda L5 den M5 satırlarının çıkışını N5 satırına sonuç veriyor onda sorun yok ama alt satırlarda dada aynı sonucu veriyor.
yani benim yapamadığım konuda burada başlıyor. L6 ya değer girdiğimde N6 ya = n5+L6-M6 sonucunu vermesini ve bu alt alta devam etmesini de yaparsak süper olur.

Yeniden ilgi ve alakanızdan dolayı çok teşekkür ederim.
İyi çalışmalar,
Saygılarımla...
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
B10 hücresine 30/7/2020 ve C10 hücresine de 31/07/2020 yazdığımda E10 hücresinde 2 sonucunu verdi? Sorun nedir?

İkinci soruna dikkat etmemişim. Aşağıdaki kodları deneyin:

PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
a = Target.Row
If Selection.Count > 1 Then Exit Sub
If Intersect(Target, [B5:C200]) Is Nothing Then GoTo 10
    If IsDate(Cells(a, "C")) And IsDate(Cells(a, "B")) Then
        If Cells(a, "C") = WorksheetFunction.EoMonth(Target, 0) Then
            Cells(a, "E") = Cells(a, "C") - Cells(a, "B") + 1
        Else
            Cells(a, "E").ClearContents
        End If
    Else
        Cells(a, "E").ClearContents
    End If
10:
If Intersect(Target, [F5:H200]) Is Nothing Then GoTo 20
    If IsNumeric(Target) Then
        Cells(a, "I") = Cells(a, "F") * Cells(a, "G") + Cells(a, "G") * Cells(a, "H")
        If IsNumeric(Cells(a, "J")) Then
            Cells(a, "K") = Round(Cells(a, "I") * Cells(a, "J"), 2)
            Cells(a, "L") = Cells(a, "I") + Cells(a, "K")
        End If
    Else
        MsgBox "F, G ve H sütununlarıa sadece tutar girebilirsiniz!", vbInformation
        Target.Select
        Target.ClearContents
        Cells(a, "I").ClearContents
    End If
20:
If Intersect(Target, [J5:J200]) Is Nothing Then GoTo 30
    If IsNumeric(Cells(a, "J")) And IsNumeric(Cells(a, "H")) Then
        Cells(a, "K") = Round(Cells(a, "I") * Cells(a, "J"), 2)
        Cells(a, "L") = Cells(a, "I") + Cells(a, "K")
    Else
        MsgBox "J sütununa sadece sayısal olarak KDV oranı girebilirsiniz!", vbInformation
        Target.Select
        Target.ClearContents
        Cells(a, "K").ClearContents
        Cells(a, "L").ClearContents
    End If
30:
If Intersect(Target, [M5:M200]) Is Nothing Then Exit Sub
    If IsNumeric(Cells(a, "L")) And IsNumeric(Cells(a, "M")) Then
        Cells(a, "N") = WorksheetFunction.Sum(Range("L4:L" & a)) - WorksheetFunction.Sum(Range("M4:M" & a))
    Else
        MsgBox "L sütununa sadece ödenen tutar girebilirsiniz!", vbInformation
        Target.Select
        Target.ClearContents
        Cells(a, "N").ClearContents
    End If
End Sub
 

ulutanas

Altın Üye
Katılım
8 Kasım 2008
Mesajlar
578
Excel Vers. ve Dili
Excel Vers. ve Dili Ofis 2021 TR 32 Bit
c sütununda 31 değilde 30 veya altı rakam girince hesap yapmıyor hocam.
219687
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Açıklamanız şu şekilde:

1-) B VE C SÜTUNLARINDA ÜRÜNLERİN GİRİŞ VE TAHSİL TARİHLERİ MEVCUT HER AY SONUNUDA HESAP YAPILMAKTA B5 HÜCRESİNDE YAZILI OLAN TARİH DEPOYA GİRİŞ TARİHİ O AYIN SON TARİHİ C5 HÜCRESİNE YAZILDIĞINDA E5 HÜCRESİNE ARADAKİ TARİH FARKINI +1 İLE VERMEKTEDİR. BUNUDA DENEDİM AMA MAALESEF YAPAMADIM.
Temmuz ayının son günü 31 olduğundan 30 yazdığınızda istediğiniz gerçekleşmez. Ayın son tarihinden anladığınız başka bir tarih mi var acaba?
 

ulutanas

Altın Üye
Katılım
8 Kasım 2008
Mesajlar
578
Excel Vers. ve Dili
Excel Vers. ve Dili Ofis 2021 TR 32 Bit
Hocam bazı müşterilerimiz 01/06/2020 de ürün girişi yapıyor 20/06/2020 de geri çekiyorlar onlardan gün hesabı alıyorum.
Bir şey daha fark ettim, I 5 de hesaplama yaparken hep 30 günü baz alıyor E5 deki değere göre çarpım yapmıyor.
 

ulutanas

Altın Üye
Katılım
8 Kasım 2008
Mesajlar
578
Excel Vers. ve Dili
Excel Vers. ve Dili Ofis 2021 TR 32 Bit
e sütununu ile çarpımını aşağıda ki gibi değiştirdim şimdi çarpım ile ilgili sorun oldu
Kod:
Cells(a, "I") = Cells(a, "F") * Cells(a, "G") + Cells(a, "G") * Cells(a, "H") / 30 * Cells(a, "E")
Tek sorun tarihi ayarlama kaldı oda olursa süper olacak hocam
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Bu konuyu açıklığa kavuşturmak lazım. Dosyanızdaki açıklamada bir hata mı var? İşlemler her ayın son gününe göre yapılmayacak mı? Her ayın son gününe göre yapılmayacaksa C sütunundaki tarihe göre mi yapılacak?

I sütunu için kodları aşağıdaki şekilde kullanın:

PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
a = Target.Row
If Selection.Count > 1 Then Exit Sub
If Intersect(Target, [B5:C200]) Is Nothing Then GoTo 10
    If IsDate(Cells(a, "C")) And IsDate(Cells(a, "B")) Then
        If Cells(a, "C") = WorksheetFunction.EoMonth(Target, 0) Then
            Cells(a, "E") = Cells(a, "C") - Cells(a, "B") + 1
        Else
            Cells(a, "E").ClearContents
        End If
    Else
        Cells(a, "E").ClearContents
    End If
10:
If Intersect(Target, [E5:H200]) Is Nothing Then GoTo 20
    If IsNumeric(Target) Then
        Cells(a, "I") = WorksheetFunction.Round(Cells(a, "F") * Cells(a, "G") + Cells(a, "G") * Cells(a, "H") * Cells(a, "E") / 30, 2)
        If IsNumeric(Cells(a, "J")) Then
            Cells(a, "K") = Round(Cells(a, "I") * Cells(a, "J"), 2)
            Cells(a, "L") = Cells(a, "I") + Cells(a, "K")
        End If
    Else
        MsgBox "F, G ve H sütununlarıa sadece tutar girebilirsiniz!", vbInformation
        Target.Select
        Target.ClearContents
        Cells(a, "I").ClearContents
    End If
20:
If Intersect(Target, [J5:J200]) Is Nothing Then GoTo 30
    If IsNumeric(Cells(a, "J")) And IsNumeric(Cells(a, "H")) Then
        Cells(a, "K") = Round(Cells(a, "I") * Cells(a, "J"), 2)
        Cells(a, "L") = Cells(a, "I") + Cells(a, "K")
    Else
        MsgBox "J sütununa sadece sayısal olarak KDV oranı girebilirsiniz!", vbInformation
        Target.Select
        Target.ClearContents
        Cells(a, "K").ClearContents
        Cells(a, "L").ClearContents
    End If
30:
If Intersect(Target, [M5:M200]) Is Nothing Then Exit Sub
    If IsNumeric(Cells(a, "L")) And IsNumeric(Cells(a, "M")) Then
        Cells(a, "N") = WorksheetFunction.Sum(Range("L4:L" & a)) - WorksheetFunction.Sum(Range("M4:M" & a))
    Else
        MsgBox "L sütununa sadece ödenen tutar girebilirsiniz!", vbInformation
        Target.Select
        Target.ClearContents
        Cells(a, "N").ClearContents
    End If
End Sub
 

ulutanas

Altın Üye
Katılım
8 Kasım 2008
Mesajlar
578
Excel Vers. ve Dili
Excel Vers. ve Dili Ofis 2021 TR 32 Bit
Evet hocam yanlış yazmışım açıklamaya o ayın son tarihi demişim. Genelde o ayın son tarihi oluyor ama bazı müşterilerde 01/06/2020 de ürün getirip ay içerindeki herhangi bir günde çekebiliyor. o noktada gün hesabı yapıldığından önemli oluyor.
En başta yanlış bilgi aktarmışım özür dilerim. :(
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Aşağıdaki kodları deneyin:

PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
a = Target.Row
If Selection.Count > 1 Then Exit Sub
If Intersect(Target, [B5:C200]) Is Nothing Then GoTo 10
    If IsDate(Cells(a, "C")) And IsDate(Cells(a, "B")) Then
        Cells(a, "E") = Cells(a, "C") - Cells(a, "B") + 1
    Else
        Cells(a, "E").ClearContents
    End If
10:
If Intersect(Target, [E5:H200]) Is Nothing Then GoTo 20
    If IsNumeric(Target) Then
        Cells(a, "I") = WorksheetFunction.Round(Cells(a, "F") * Cells(a, "G") + Cells(a, "G") * Cells(a, "H") * Cells(a, "E") / 30, 2)
        If IsNumeric(Cells(a, "J")) Then
            Cells(a, "K") = Round(Cells(a, "I") * Cells(a, "J"), 2)
            Cells(a, "L") = Cells(a, "I") + Cells(a, "K")
        End If
    Else
        MsgBox "F, G ve H sütununlarıa sadece tutar girebilirsiniz!", vbInformation
        Target.Select
        Target.ClearContents
        Cells(a, "I").ClearContents
    End If
20:
If Intersect(Target, [J5:J200]) Is Nothing Then GoTo 30
    If IsNumeric(Cells(a, "J")) And IsNumeric(Cells(a, "H")) Then
        Cells(a, "K") = Round(Cells(a, "I") * Cells(a, "J"), 2)
        Cells(a, "L") = Cells(a, "I") + Cells(a, "K")
    Else
        MsgBox "J sütununa sadece sayısal olarak KDV oranı girebilirsiniz!", vbInformation
        Target.Select
        Target.ClearContents
        Cells(a, "K").ClearContents
        Cells(a, "L").ClearContents
    End If
30:
If Intersect(Target, [M5:M200]) Is Nothing Then Exit Sub
    If IsNumeric(Cells(a, "L")) And IsNumeric(Cells(a, "M")) Then
        Cells(a, "N") = WorksheetFunction.Sum(Range("L4:L" & a)) - WorksheetFunction.Sum(Range("M4:M" & a))
    Else
        MsgBox "L sütununa sadece ödenen tutar girebilirsiniz!", vbInformation
        Target.Select
        Target.ClearContents
        Cells(a, "N").ClearContents
    End If
End Sub
 

ulutanas

Altın Üye
Katılım
8 Kasım 2008
Mesajlar
578
Excel Vers. ve Dili
Excel Vers. ve Dili Ofis 2021 TR 32 Bit
Hocam yanlış bilgi aktarı ile size de bir sürü zahmet ettirdim, kusuruma bakmayın lütfen.

Her şey şimdi tam istediğim gibi oldu çok teşekkür ederim. :)

İyi çalışmalar,
Saygılarımla...
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Aslında formülleri bozan arkadaşlarınız bu durumda da araya satır sütun vs ekleyip kodların hatalı çalışmasına neden olabilir. Bunu önlemek için formüllü hücrelerinizi kilitleyip (değiştirilebilecek hücrelerin kilidini kaldırıp) dosyayı şifreli olarak korumanız daha doğru olacaktır.

İyi çalışmalar.
 

ulutanas

Altın Üye
Katılım
8 Kasım 2008
Mesajlar
578
Excel Vers. ve Dili
Excel Vers. ve Dili Ofis 2021 TR 32 Bit
Dediğiniz gibi korumalarını aktif yapacağım hocam, tekrar teşekkür ederim.

İyi çalışmalar,
Saygılarımla...
 

ulutanas

Altın Üye
Katılım
8 Kasım 2008
Mesajlar
578
Excel Vers. ve Dili
Excel Vers. ve Dili Ofis 2021 TR 32 Bit
Yusuf hocam merhaba
Yine muhasebede çalışan arkadaşlar sorun buldu,
Her satırda ödeme kısmına değer girmeden kalan satırı sonuç vermiyor dediler, bende ısrarla her yapılan kayıtta ödeme değeri verin satırı bitirmeden diğer satıra geçmeyin diyorum ama dinletemedim yine :)
En sonunda aşağıda ki kodda bir ekleme yaptım şimdilik bir sorun vermiyor,
Sizden ricam aşağıdaki kodu kontrol kontrol edebilir misiniz, yanlış bir nokta var mı? İleride sıkıntı olur mu?

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next

a = Target.Row
If Selection.Count > 1 Then Exit Sub
If Intersect(Target, [B5:C200]) Is Nothing Then GoTo 10
    If IsDate(Cells(a, "C")) And IsDate(Cells(a, "B")) Then
        Cells(a, "E") = Cells(a, "C") - Cells(a, "B") + 1
       Cells(a, "M") = Cells(a, "m") + "0"
    Else
       Cells(a, "E").ClearContents
    End If
10:
If Intersect(Target, [E5:H200]) Is Nothing Then GoTo 20
    If IsNumeric(Target) Then
        Cells(a, "I") = WorksheetFunction.Round(Cells(a, "F") * Cells(a, "G") + Cells(a, "G") * Cells(a, "H") * Cells(a, "E") / 30, 2)
        If IsNumeric(Cells(a, "J")) Then
            Cells(a, "K") = Round(Cells(a, "I") * Cells(a, "J"), 2)
            Cells(a, "L") = Cells(a, "I") + Cells(a, "K")
            Cells(a, "M") = Cells(a, "m") + "0"
            
        End If
    Else
        MsgBox "F, G ve H sütununlarıa sadece tutar girebilirsiniz!", vbInformation
        Target.Select
        Target.ClearContents
        Cells(a, "I").ClearContents
    End If
20:
If Intersect(Target, [J5:J200]) Is Nothing Then GoTo 30
    If IsNumeric(Cells(a, "J")) And IsNumeric(Cells(a, "H")) Then
        Cells(a, "K") = Round(Cells(a, "I") * Cells(a, "J"), 2)
        Cells(a, "L") = Cells(a, "I") + Cells(a, "K")
       Cells(a, "M") = Cells(a, "m") + "0"
    Else
        MsgBox "J sütununa sadece sayısal olarak KDV oranı girebilirsiniz!", vbInformation
        Target.Select
        Target.ClearContents
        Cells(a, "K").ClearContents
        Cells(a, "L").ClearContents
        
    End If
30:
If Intersect(Target, [M5:M200]) Is Nothing Then Exit Sub
    If IsNumeric(Cells(a, "L")) And IsNumeric(Cells(a, "M")) Then
        Cells(a, "N") = WorksheetFunction.Sum(Range("L4:L" & a)) - WorksheetFunction.Sum(Range("M4:M" & a))
    Else
        MsgBox "M sütununa sadece ödenen tutar girebilirsiniz!", vbInformation
        Target.Select
        Target.ClearContents
      
    End If
End Sub
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Merhaba. Çözümlerimizi genel olarak bizden istenenlere göre yapmaya çalışıyoruz. Buna ilişkin isteğiniz olmayınca ben de düşünemedim doğal olarak.

Kendiniz gayet güzel pratik bir çözüm bulmuşsunuz gördüğüm kadarıyla. Şunu hatırlatayım: makroda sayıları tırnak içinde yazmanız gerekmez.
 

ulutanas

Altın Üye
Katılım
8 Kasım 2008
Mesajlar
578
Excel Vers. ve Dili
Excel Vers. ve Dili Ofis 2021 TR 32 Bit
Bende normalde öyle olmasını daha mantıklı buluyordum her satırda bir işlem bitene kadar devam etsinler doğru yaptıklarından emin olsunlar diye ama pratik işleri çok seviyor elemanlar :)

Makroda sayıları tırnak içine almaya gerek olmadığını da şimdi sizden öğrendim,
çok teşekkürler hocam sayenizde bir şey daha öğrendim.

İyi çalışmalar,
Saygılarımla...
 
Üst