Makro İle Fiyat Dağıtma

[eceLprensi]

Merhaba Üstatlarım,

Büyük bir sorunum var.
Set kodu var ve fiyat bu koda geliyor.
Set içeriğinde ise 2 - 3 - 4 - 5 ürün bağlı ve bunlara fiyat gelmiyor.
Set 1500Tl
Yastık 0TL
Nevresim 0 TL
Çarşaf 0TL
gibi.

Bende ürünlerin birim fiyatlarına göre dağıtmak istiyorum.
Ekte örnekte attım. çok çok Teşekkür ederim.

İyi çalışmalar.

 

[nunikmakarios]

Açıklama yereli değil, ne yapmak istediğinizi anlamdım

 

[hüseyintok]

Arkadaş diyo ki 2000 TL kampanya fiyatı ama ürün toplamı 2050 TL kampanyasız fiyata göre % kaçlık kısıma ürün geliyorsa fiyattını ona göre hesaplasın istiyor. ürün toplamı 2000 olsun sonuçta diyor

 

[eceLprensi]

Ekteki dosyada Set Fiyatları mevcut
Sipariş numarasına bakarak birim fiyatına göre setin fiyarını dağıtmasını istiyorum.

Örneğin

1​	Banyo set	11​	2000​	Diğer detaylar​	1800 TL​	Fiyat Listesine Göre oran	Satış Fyatına Göre TL
1​	Terlik	11​	150​		Hesaplama	7%​	131,7073​
1​	Havlu	11​	1500​		Hesaplama	63%​	1125​
1​	Tarak	11​	400​		Hesaplama	31%​	553,8462 ​

Banyo setin bir fatura fiyatı var.
Setin altındaki (hesaplama yazan yer) burada fiyat yok.

Bende Set fyatını Sipariş numarasına bağlı olarak 1800TL yi

150+1500+400=2050
150/ 2050 = %7
1500/2050 = %63
400/2050 = %40

1800 Tl ile çarparak
1800 * %7 = 131,7
1800* %63= 1125
1800**%31 = 553 lira
Yazdırmak istiyorum.

 

[Cengiz Demir]

Kod üzerinde çalışırken bazı cevaplar gelmiş.

Dim ilk As Long
Dim ilk As Long: Dim son As Long: Dim tpl As Long: Dim tut As Long
Dim sstr As Long: Dim i As Long: Dim x As Long: Dim y As Long
Dim z As Long

Sub Dagit()

sstr = Cells(Rows.Count, 1).End(xlUp).Row
y = 3

For i = 2 To sstr

   ilk = Cells(i, 3).Value
   son = Cells(y, 3).Value
   tut = Cells(i, 6).Value
   
        Do While ilk = son
    
            tpl = Cells(y, 4) + tpl
            y = y + 1
            son = Cells(y, 3).Value
       
        Loop

        For x = i + 1 To y - 1
    
            Cells(x, 6).Value = Round((Cells(x, 4).Value / tpl) * tut, 2)

        Next x
    
    i = y - 1
    y = y + 1
    tpl = 0
    
Next i

End Sub

 

[eceLprensi]

Teşekkürler
Cells(x, 6).Value = Round((Cells(x, 4).Value / tpl) * tut, 2)

250000 satırda. Kodda hata veriyor


ekteki dosyada sorunsuz çalışıyor.

X değerini 250000 yapmalıyım

 

[Cengiz Demir]

Rica ederim.

Az önce, örnek verilerinizden 270 000 satır oluşturup deneme yaptım. Hata vermeden bitirdi.

O satırda ne hata verdiğini, hatta o gurubun verilerini başka dosyaya kopyalayıp gönderebilirseniz kontrol edelim.
(Veri formatıyla ilgili bir sorun olabilir.)

Gerçi silmişsinizdir. Kodlardaki aşağıda belirttiğim ilk satır fazlalık olmuş. Hata onunla ilgili değildir.
Ama eğer duruyorsa onu da siliverin.

Dim ilk As Long
Dim ilk As Long:

 

[eceLprensi]

Teşekürler. Hatayı buldum. Fiyatı gelmeyen olduğunda hata ile dönüyor.

Birim TL sıfır ise hata veriyor

 

[Cengiz Demir]

Rica ederim.