Çoklu iskonto hesaplama

Katılım
17 Nisan 2007
Mesajlar
319
Excel Vers. ve Dili
Office 2013 Türkçe
Arkadaşlar Merhaba,

Ekteki dosyamızda bir makro çalışmaktadır. Sonradan G ve H sütunları ilave edildi.

Şimdi yapmak istediğimiz kısaca ;

F sütunu ve G sütunundaki iskontolar toplanacak. Sonuç D sütunundan (KDV HARIC FIYAT) % olarak çıkartılıp H sütununa yazdırılacak.

Varolan makromuza bunların ilave edilmesini sağlayabilirmiyiz acaba ?
Şimdiden herkese teşekkürler...

http://s6.dosya.tc/server9/6fzr5a/SABLONV3.rar.html

Saygılar,
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,248
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Buyurun.:cool:
Kod:
Sub FIYATLA()

Application.ScreenUpdating = False
Set sf = ThisWorkbook.Worksheets("FIYATLAMA")
Set ss = ThisWorkbook.Worksheets("SIRKULER")
    For i = 2 To 100433
        For k = 10 To sf.Range("b65536").End(xlUp).Row
        If sf.Cells(k, 2) = ss.Cells(i, 1) Then
            sf.Cells(k, 3) = ss.Cells(i, 3)
            sf.Cells(k, 4) = ss.Cells(i, 4)
            sf.Cells(k, 5) = ss.Cells(i, 6)
            sf.Cells(k, 6) = ss.Cells(i, 7)
            [B][COLOR="Red"]sf.Cells(k, "H").Value = (ss.Cells(i, "F").Value + ss.Cells(i, "G").Value) _
                    - ss.Cells(i, "D").Value[/COLOR][/B]
        End If
        Next k
    Next i
    



[D30] = WorksheetFunction.Sum([D10:D29])
[E30] = WorksheetFunction.Sum([E10:E29])
[H30] = WorksheetFunction.Sum([H10:H29])
[I30] = WorksheetFunction.Sum([I10:I29])
sf.Range("D30").Font.Bold = True
sf.Range("E30").Font.Bold = True
sf.Range("H30").Font.Bold = True
sf.Range("I30").Font.Bold = True

Application.ScreenUpdating = True


End Sub
 
Katılım
17 Nisan 2007
Mesajlar
319
Excel Vers. ve Dili
Office 2013 Türkçe
Evren Hocam ,

% olarak hesaplama yapması lazım. Yani ; 15+8 ise %23 olarak alması lazım
KDVHARIC fiyattan iskontoların %toplamını çıkarıp net fiyatı almamız gerekiyor.

Örnek ;
D10 F10 G10 H10
41,15 15 8 = 31,6855 olmazı lazım

Yani ; =D10-(D10*(F10+G10)/100) formülünün yaptığı işlemi yaptırmamız gerekiyor hocam.
Teşekkürler...
 
Son düzenleme:
Katılım
17 Nisan 2007
Mesajlar
319
Excel Vers. ve Dili
Office 2013 Türkçe
Yani ; =D10-(D10*(F10+G10)/100) formülünün yaptığı işlemi yaptırmamız gerekiyor hocam.
Teşekkürler...
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,248
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Yani ; =D10-(D10*(F10+G10)/100) formülünün yaptığı işlemi yaptırmamız gerekiyor hocam.
Teşekkürler...
Buyurun.:cool:
Kod:
sf.Cells(k, "H").Value = ss.Cells(i, "D").Value - (ss.Cells(i, "D").Value * _
                    (ss.Cells(i, "F").Value + ss.Cells(i, "G").Value) / 100)
 

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
12,997
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Altın Üyelik Bitiş Tarihi
(18.03.2020) - Uzman olduğu için tarih geçersiz oldu.
Merhaba.

Anladığım kadarıyla SIRKULER sayfasında EKSTRA ISKONTO bilgisi yok ve
bu oranlar sayfaya elle yazılmak durumunda.

Bence işlem iki aşamada gerçekleştirilmeli.
-- Birinci aşama MALZEME KODU bilgisinden hareketle SIRKULER sayfasındaki bilgilerin çekilmesi,
-- MALZEMElerin karşılarına yazılacak İLAVE İSKONTO oranı da dikkate alınarak NET FİYATLARIN hesaplanması.

Bunun için sayfaya iki adet düğme/şekil/metin kutusu ekleyip,
-- birinci düğmeyi FIYATLA kodu ile,
-- ikinci düğmeyi ise FIYATLA2 kodu ile
ilişkilendirerek işlem tamamlanmalı diye düşünüyorum.
.
Kod:
[B][COLOR="Blue"]Sub FIYATLA()[/COLOR][/B]
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set wf = Application.WorksheetFunction
Set sf = ThisWorkbook.Worksheets("FIYATLAMA")
Set ss = ThisWorkbook.Worksheets("SIRKULER")
If sf.Cells(Rows.Count, 3).End(3).Row > 9 Then
    sf.Range("A10:A" & Rows.Count).ClearContents
    sf.Range("C10:H" & Rows.Count).ClearContents
End If
    For k = 10 To sf.Range("b65536").End(xlUp).Row
        If wf.CountIf(ss.Range("A:A"), sf.Cells(k, 2)) = 0 Then
            MsgBox "FİYATLAMA sayfası B" & k & " hücresindeki PARÇA KODU," _
                & vbLf & "SIRKULAR sayfasında YOK!..", vbCritical
            GoTo 10
        Else
    sf.Cells(k, 1) = k - 9
    sf.Cells(k, 3) = ss.Cells(wf.Match(sf.Cells(k, 2), ss.Range("A:A"), 0), 3)
    sf.Cells(k, 4) = ss.Cells(wf.Match(sf.Cells(k, 2), ss.Range("A:A"), 0), 4)
    sf.Cells(k, 5) = ss.Cells(wf.Match(sf.Cells(k, 2), ss.Range("A:A"), 0), 6)
    sf.Cells(k, 6) = ss.Cells(wf.Match(sf.Cells(k, 2), ss.Range("A:A"), 0), 7)
        End If
10: Next k
Cells(k + 5, 4) = wf.Sum(sf.Range(sf.Cells(10, 4), sf.Cells(k - 1, 4)))
Cells(k + 5, 5) = wf.Sum(sf.Range(sf.Cells(10, 5), sf.Cells(k - 1, 5)))
sf.Range(sf.Cells(k + 5, 1), sf.Cells(k + 5, 5)).Font.Bold = True
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
[B][COLOR="blue"]End Sub[/COLOR][/B]

[B][COLOR="Red"]Sub FIYATLA2()[/COLOR][/B]
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
Set wf = Application.WorksheetFunction
Set sf = ThisWorkbook.Worksheets("FIYATLAMA")
For k = 10 To sf.Range("b65536").End(xlUp).Row
    sf.Cells(k, 8) =[B][COLOR="Red"] (Cells(k, 4) * (100 - Cells(k, 6)) / 100) * (100 - Cells(k, 7)) / 100[/COLOR][/B]
Next k
Cells(k + 5, 8) = wf.Sum(sf.Range(sf.Cells(10, 8), sf.Cells(k - 1, 8)))
sf.Range(sf.Cells(k + 5, 8), sf.Cells(k + 5, 8)).Font.Bold = True
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
[B][COLOR="red"]End Sub[/COLOR][/B]
 
Katılım
17 Nisan 2007
Mesajlar
319
Excel Vers. ve Dili
Office 2013 Türkçe
Merhaba.

Anladığım kadarıyla SIRKULER sayfasında EKSTRA ISKONTO bilgisi yok ve
bu oranlar sayfaya elle yazılmak durumunda.

Bence işlem iki aşamada gerçekleştirilmeli.
-- Birinci aşama MALZEME KODU bilgisinden hareketle SIRKULER sayfasındaki bilgilerin çekilmesi,
-- MALZEMElerin karşılarına yazılacak İLAVE İSKONTO oranı da dikkate alınarak NET FİYATLARIN hesaplanması.

Bunun için sayfaya iki adet düğme/şekil/metin kutusu ekleyip,
-- birinci düğmeyi FIYATLA kodu ile,
-- ikinci düğmeyi ise FIYATLA2 kodu ile
ilişkilendirerek işlem tamamlanmalı diye düşünüyorum.
.
Kod:
[B][COLOR="Blue"]Sub FIYATLA()[/COLOR][/B]
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set wf = Application.WorksheetFunction
Set sf = ThisWorkbook.Worksheets("FIYATLAMA")
Set ss = ThisWorkbook.Worksheets("SIRKULER")
If sf.Cells(Rows.Count, 3).End(3).Row > 9 Then
    sf.Range("A10:A" & Rows.Count).ClearContents
    sf.Range("C10:H" & Rows.Count).ClearContents
End If
    For k = 10 To sf.Range("b65536").End(xlUp).Row
        If wf.CountIf(ss.Range("A:A"), sf.Cells(k, 2)) = 0 Then
            MsgBox "FİYATLAMA sayfası B" & k & " hücresindeki PARÇA KODU," _
                & vbLf & "SIRKULAR sayfasında YOK!..", vbCritical
            GoTo 10
        Else
    sf.Cells(k, 1) = k - 9
    sf.Cells(k, 3) = ss.Cells(wf.Match(sf.Cells(k, 2), ss.Range("A:A"), 0), 3)
    sf.Cells(k, 4) = ss.Cells(wf.Match(sf.Cells(k, 2), ss.Range("A:A"), 0), 4)
    sf.Cells(k, 5) = ss.Cells(wf.Match(sf.Cells(k, 2), ss.Range("A:A"), 0), 6)
    sf.Cells(k, 6) = ss.Cells(wf.Match(sf.Cells(k, 2), ss.Range("A:A"), 0), 7)
        End If
10: Next k
Cells(k + 5, 4) = wf.Sum(sf.Range(sf.Cells(10, 4), sf.Cells(k - 1, 4)))
Cells(k + 5, 5) = wf.Sum(sf.Range(sf.Cells(10, 5), sf.Cells(k - 1, 5)))
sf.Range(sf.Cells(k + 5, 1), sf.Cells(k + 5, 5)).Font.Bold = True
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
[B][COLOR="blue"]End Sub[/COLOR][/B]

[B][COLOR="Red"]Sub FIYATLA2()[/COLOR][/B]
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
Set wf = Application.WorksheetFunction
Set sf = ThisWorkbook.Worksheets("FIYATLAMA")
For k = 10 To sf.Range("b65536").End(xlUp).Row
    sf.Cells(k, 8) = Cells(k, 4) - (Cells(k, 4) * (Cells(k, 6) + Cells(k, 7)) / 100)
Next k
Cells(k + 5, 8) = wf.Sum(sf.Range(sf.Cells(10, 8), sf.Cells(k - 1, 8)))
sf.Range(sf.Cells(k + 5, 8), sf.Cells(k + 5, 8)).Font.Bold = True
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
[B][COLOR="red"]End Sub[/COLOR][/B]
Ömer Hocam selamlar ,

Öncelikle tam doğru bir yorumda bulunmuşsunuz ve dolayısıyla tam istenilen kodu yazmışsınız.
Ayrıca ; Yazmış olduğunuz kod , benim kullandığım koddan daha hızlı.. Ellerinize sağlık , çok teşekkür ederim..
Saygılar,
 
Katılım
17 Nisan 2007
Mesajlar
319
Excel Vers. ve Dili
Office 2013 Türkçe
Ömer Hocam ,

Benim bir yanlış anlamamdan dolayı hesaplama kısmında bir hata oluyor.
Şimdi şöyle olacakmış ;
KDV HARIC fiyattan iskonto oranı (%15 gibi) çıkartılarak net fiyat bulunacak. İlave iskonto varsa çıkan net fiyattan ilave iskonto oranı çıkartılarak esas net fiyat bulunacakmış :)

Bunu düzenlememiz mümkün olurmu acaba ?
İnşallah anlatabilmişimdir...
 
Son düzenleme:

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
12,997
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Altın Üyelik Bitiş Tarihi
(18.03.2020) - Uzman olduğu için tarih geçersiz oldu.
Ömer Hocam ,

Benim bir yanlış anlamamdan dolayı hesaplama kısmında bir hata oluyor.
Şimdi şöyle olacakmış ;
KDV HARIC fiyattan iskonto oranı (%15 gibi) çıkartılarak net fiyat bulunacak. İlave iskonto varsa çıkan net fiyattan ilave iskonto oranı çıkartılarak esas net fiyat bulunacakmış :)

Bunu düzenlememiz mümkün olurmu acaba ?
İnşallah anlatabilmişimdir...
Tekrar merhaba.

6 numaralı cevabımdaki FIYATLA2 adlı, alttaki kod blokunda değişiklik yaptım (kırmızı renklendirdiğim kısım).

Yeni halini kullanabilirsiniz. İyi çalışmalar.
.
 
Katılım
17 Nisan 2007
Mesajlar
319
Excel Vers. ve Dili
Office 2013 Türkçe
Çok teşekkür ederim Ömer Bey,

Emeğinize sağlık sağolun. :dua2:
Saygılar,
 

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
12,997
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Altın Üyelik Bitiş Tarihi
(18.03.2020) - Uzman olduğu için tarih geçersiz oldu.
Üst