eceLprensi
Altın Üye
- Katılım
- 30 Ekim 2007
- Mesajlar
- 97
- Excel Vers. ve Dili
- 2016
- Altın Üyelik Bitiş Tarihi
- 29-06-2025
Merhaba Üstadlarım
Makro ile Ürünlerin fiyatlarını yok olarak dağıtmak istiyorum.
Birim Fiyatı makul olmayanları da dağıtmak istiyorum.
gibi ürünler oran vermek istiyorum.
Sub Dagit()
Zaman = Timer
sstr = Cells(Rows.Count, 1).End(xlUp).Row
y = 3
Toplam = 0
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
MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
"İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub
Makro ile Ürünlerin fiyatlarını yok olarak dağıtmak istiyorum.
Birim Fiyatı makul olmayanları da dağıtmak istiyorum.
Nevresim seti |
yastık kabı |
Çarşaf |
Nevresim takımı |
gibi ürünler oran vermek istiyorum.
Sub Dagit()
Zaman = Timer
sstr = Cells(Rows.Count, 1).End(xlUp).Row
y = 3
Toplam = 0
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
MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
"İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub
Ekli dosyalar
-
9.7 KB Görüntüleme: 4