sayı katları

[ayarse]

İyi akşamlar bir soru sormak istiyorum.

A1 Hücresine sayı girdiğimde B1(4) C1(2)- VE D1(1) olacak şekilde dağıtmasını istiyorum mesela A1 14 yazdığında B1=8 C1=4 D1=2 olmalı ve fazlalık kalanları da B1 den başlayarak dağıtmasını istiyorum.
Yardımcı olursanız sevinirim teşekkürler

 

[Emir Hüseyin Çoban]

Biraz daha ayrıntı vermelisiniz.
Bu dağıtım oranları sabit mi neye göre oluşuyor.
Bir sayı için daha örnek veriniz.

 

[ayarse]

bu formulü 1 ayda kullanacağım ve her gün değişecek ayın 1 inde 32 ayın 2 sinde 34 gibi yani belli bir sayı yok
dağıtım ise sabit 1. hücre 4 - 2. hücre 2 - 3. hücre 1 olacak şekilde yani 1 hücre 12 olduğunda 2. hücre 6 ve 1 hücre 3 olması gerekli sayının tam bölünemediği durumlarda ise kalan sayılar 1 hücreden başlayıp dağıtılacak

 

[ayarse]

mesela A1 34 olduğunda B1=18 , C1=10, D1=6 olacak

 

[ayarse]

dedim ama yanlış dedim muhtemelen A1 34 olduğunda B1 19 C1=9, D1_5 olmalı
kural hep 4-2-1 şeklinde dağıtılması olmalı yazılmış.
kalanlar konusunda emin olamıyorum aslında
6 olduğunda 3-2-1
5 olduğunda 2-2-1
4 olduğunda 2-1-1
3 olduğunda 1-1-1
2 olduğunda 1-1-0
1 olduğunda 1-0-0 olmalı sanırım

 

[YUSUF44]

Kuralı tam olarak belirtmeniz iyi olurdu. Anlamadığım nokta verdiğiniz örnekte neden kalanın yarısını ilk hücreye ekliyoruz. Verdiğiniz kurala göre 16-8-4 olarak dağıtılıp kalanın da 2-2-2 olarak paylaştırılması ve sonucun 18-10-6 olması gerekmez mi?

 

[YUSUF44]

Bir şeyler yapmaya çalıştım. Aşağıdaki kodları ilgili sayfanın kod bölümüne yapıştırıp dener misiniz? uygunsa kodlar üzerinden düzeltme yapmaya çalışırız.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("a1")) Is Nothing Then Exit Sub
Target.Offset(0, 1) = Int(Target / 7 * 4)
Target.Offset(0, 2) = Int(Target / 7 * 2)
Target.Offset(0, 3) = Int(Target / 7)
If WorksheetFunction.Sum(Range(Cells(Target.Row, 2), Cells(Target.Row, 4))) < Target Then
kalan = Target - WorksheetFunction.Sum(Range(Cells(Target.Row, 2), Cells(Target.Row, 4)))
For art = 1 To kalan
    For hucre = 2 To 4
    Cells(Target.Row, hucre) = Cells(Target.Row, hucre) + WorksheetFunction.Max(0, WorksheetFunction.Min(1, kalan))
    kalan = kalan - 1
    Next
Next
End If
End Sub

 

[ayarse]

Kalan konusunda hala emin değilim belkide 1. 4 olana kadar 1. hücreye sonra 2. hücreyede olabilir. Henüz bir açıklık yok. Ama kodu oluşturunca üzerinde değişiklik olabilir diye düşünüyorum

 

[ayarse]

Kod uygun çok teşekkür ederim.
Benim VBA bilgim hiç yok sadece excelde fonksiyon özelliği kullanılarak yapılabilirmi diye düşünmüştüm. Başka bir sayfaya sonuçları yazıp =DÜŞEYARA(A1;ALAN1;3;0) gibi bir formülle yaptım. Sonuç çıkıyor ama çok kullanışlı değil. Sizin yazdığınız kod daha uygun geldi.
Ama şimdi şöyle bir sorunum var. B1- C1-D1 hücreleri değilde farklı hücre ve sütunda 31 gün olacak şekilde yazmak gerekli. Formül kopyalanabiliyor ama kodu nasıl yaparım bilemedim. Birde kalan kısmında değişiklik olursa kodu nasıl düzeltmeliyim.
Şimdiden teşekkürler

 

[YUSUF44]

Madem size 31 sütun lazım neden 3 sütun olarak sordunuz ki?

Sorunuzu esas ihtiyacınız olduğu şekilde tekrar sorar mısınız?

 

[ayarse]

Bilmediğim için o şekilde sordum. Formül gibi kolayca düzenlenebileceğini düşündüm, kusura bakmayın.
Yapmak istediğim tablo aslında daha kapsamlı ve uzun . A sütununda A8 den başlayarak tarih var ve 31 günden A39 a kadar sürüyor. Formüller her sütunda 8. Satırdan , 39. Satıra kadar var. Yapılması gereken işlemler şöyle
1- E sütununda (8. Satırdan 39. Satıra kadar ) B+ C +D Sütunlarını toplayacak
Örnek1 : B12=28, C12=16, D12=8 ise E12=52
Örnek2 : B25=4, C25=2, D25=1 ise E25=7 olmalı
2- F sütununda ise E sütununda bulunan sonucu içeren bir formül var. Tabi 8. Satırdan 39.
Satıra kadar: E/3 X (1+ (E-60)/100 ) işlemi yapılır.
Ve bulunan sonuç küsürlü ise üst sayıya tamamlanır.
Örnek 1: E13=90 ise E13/3 * (1+(E13-60)/100)
90/3*(1+(90-60)/100) = 39 F13=39 olur
Örnek2: E29=72 ise 72/3*(1+(72-60)/100)=26,88 üst sayıya tamamlanır. F29=27 olur.
3- Forumda ilk sorduğum soru ise bu kısımda kullanılır. Yani F sütununda bulunan rakam G-J-M
Sütunlarına 4-2-1 olacak şekilde dağıtılır. (8. Satırdan 39. Satıra kadar)Kalanlar ise
6 Kalan olduğunsa G sütununa 4 J sütununa 2
5 Kalan olduğunsa G sütununa 4 J sütununa 1
4 Kalan olduğunsa G sütununa 4 J sütununa 0
3 Kalan olduğunsa G sütununa 3 J sütununa 0
2 Kalan olduğunsa G sütununa 2
1 Kalan olduğunsa G sütununa 1 şeklinde dağıtılır.
Örnek1: F17=21 ise G17=12, J17=6, M17=3 olur
Örnek2: F9=40 ise G9=24, J9=11, M9=5 olur
4- Son olarakta I-L-O sütunlarında çıkarma işlemi yapılacak(8. Satırdan 39. Satıra kadar)
I sütununda G sütunundan H sütunu çıkarılacak
L sütununda J sütunundan K sütunu çıkarılacak
O sütununda M sütunundan N sütunu çıkarılacak
Sonuç 0 sayısının altı ise 0 değilse çıkan sayı yazılacak
Örnek1: G16=18 ve H16=10 ise I16=8 olur
Örnek2: J22=16 ve K22=18 ise L22=0 olur
Örnek3: M32=14 ve N32=14 ise O32=0 olur.

Umarım yanlışlık yoktur. Biraz uzun oldu sanırım. Yapılabilir mi bilmiyorum. Şimdiden ellerinize sağlık
Birde kod yazımı ile ilgili doküman kitap, site öneriniz olursa sevinirim.

 

[YUSUF44]

Aşağıdaki kodları bir modüle yapıştırıp dener misiniz?

Sub dağıt()
ssat = Cells(Rows.Count, 1).End(3).Row
For sat = 8 To ssat
Cells(sat, 5) = WorksheetFunction.Sum(Range(Cells(sat, 2), Cells(sat, 4)))
Cells(sat, 6) = WorksheetFunction.RoundUp(Cells(sat, 5) / 3 * (1 + (Cells(sat, 5) - 60) / 100), 0)
If Cells(sat, 6) >= 7 Then
Cells(sat, 7) = Int(Cells(sat, 6) / 7 * 4)
Cells(sat, 10) = Int(Cells(sat, 6) / 7 * 2)
Cells(sat, 13) = Int(Cells(sat, 6) / 7)
Else
Cells(sat, 7) = WorksheetFunction.Min(4, Cells(sat, 6))
Cells(sat, 10) = WorksheetFunction.Min(Cells(sat, 6) - Cells(sat, 7), WorksheetFunction.Max(2, Cells(sat, 6) - Cells(sat, 7)))
Cells(sat, 13) = WorksheetFunction.Min(Cells(sat, 6) - Cells(sat, 7) - Cells(sat, 10), WorksheetFunction.Max(2, Cells(sat, 6) - Cells(sat, 7) - Cells(sat, 10)))
End If
Cells(sat, 9) = WorksheetFunction.Max(0, Cells(sat, 7) - Cells(sat, 8))
Cells(sat, 12) = WorksheetFunction.Max(0, Cells(sat, 10) - Cells(sat, 11))
Cells(sat, 15) = WorksheetFunction.Max(0, Cells(sat, 13) - Cells(sat, 14))
Next
End Sub

ekleme: kodlarla ilgili kaynak olarak bu siteyi kullanabilirsiniz. 2-3 sene önce nerdeyse hiç bilmiyordum, şu anda çok az biliyorum, benim bildiklerim burdaki bilgili arkadaşlarımızın yanında devede kulak.

 

[ayarse]

Kodları kopyaladım çalışıyor. Ellerinize sağlık .
Yalnız G-J ve M sütunlarına dağıtımda sorun var. Toplamda F sütunundaki sayıyı vermiyor. Birde dağıtımı ilk sorduğum şekilde değilde daha sonraki yazdığım şekilde, yani:
6 Kalan olduğunda G sütununa 4 J sütununa 2
5 Kalan olduğunda G sütununa 4 J sütununa 1
4 Kalan olduğunda G sütununa 4 J sütununa 0
3 Kalan olduğunda G sütununa 3 J sütununa 0
2 Kalan olduğunda G sütununa 2
1 Kalan olduğunda G sütununa 1 şeklinde olursa iyi olur.
Birde makro çalışma sayfasını açtığında kendiliğinden çalıştırılamaz mı? Her seferinde makroyu çalıştırmalımıyım?
Şimdiden teşekkürler

 

[ayarse]

Yazdığınız kodun görüntülenemez ve değiştirilemez olması mümkün mü?

 

[YUSUF44]

Dağıtımdaki problemi hallettiğimi düşünüyorum. Kodları aşağıdakiyle değiştirip deneyin.

7'den küçük olanlarla ilgili zaten belirttiğiniz gibi dağıtım yapıyordu, ona karışmadım.

Sub dağıt()
ssat = Cells(Rows.Count, 1).End(3).Row
For sat = 8 To ssat
Cells(sat, 5) = WorksheetFunction.Sum(Range(Cells(sat, 2), Cells(sat, 4)))
Cells(sat, 6) = WorksheetFunction.RoundUp(Cells(sat, 5) / 3 * (1 + (Cells(sat, 5) - 60) / 100), 0)
If Cells(sat, 6) >= 7 Then
Cells(sat, 7) = Int(Cells(sat, 6) / 7 * 4)
Cells(sat, 10) = Int(Cells(sat, 6) / 7 * 2)
Cells(sat, 13) = Int(Cells(sat, 6) / 7)
Else
Cells(sat, 7) = WorksheetFunction.Min(4, Cells(sat, 6))
Cells(sat, 10) = WorksheetFunction.Min(Cells(sat, 6) - Cells(sat, 7), WorksheetFunction.Max(2, Cells(sat, 6) - Cells(sat, 7)))
Cells(sat, 13) = WorksheetFunction.Min(Cells(sat, 6) - Cells(sat, 7) - Cells(sat, 10), WorksheetFunction.Max(2, Cells(sat, 6) - Cells(sat, 7) - Cells(sat, 10)))
End If
If Cells(sat, 7) + Cells(sat, 10) + Cells(sat, 13) < Cells(sat, 6) Then
kalan = Cells(sat, 6) - (Cells(sat, 7) + Cells(sat, 10) + Cells(sat, 13))
a = Cells(sat, 7)
b = Cells(sat, 10)
Cells(sat, 7) = Cells(sat, 7) + WorksheetFunction.Min(4, kalan)
kalan = kalan - (Cells(sat, 7) - a)
Cells(sat, 10) = Cells(sat, 10) + WorksheetFunction.Min(2, kalan)
kalan = kalan - (Cells(sat, 10) - b)
Cells(sat, 13) = Cells(sat, 13) + WorksheetFunction.Min(1, kalan)
End If
Cells(sat, 9) = WorksheetFunction.Max(0, Cells(sat, 7) - Cells(sat, 8))
Cells(sat, 12) = WorksheetFunction.Max(0, Cells(sat, 10) - Cells(sat, 11))
Cells(sat, 15) = WorksheetFunction.Max(0, Cells(sat, 13) - Cells(sat, 14))
Next
End Sub

Makroyu çalışma sayfası açıldığında çalıştırmak istiyorsanız ilgili sayfanın kod bölümüne aşağıdaki kodları yapıştırmalısınız. Sayfayı her açtığınızda dağıt makrosu çalışacaktır.

Private Sub Worksheet_Activate()
dağıt
End Sub

Makroyu korumak için kod sayfasındayken modülün özelliklerine girip protection sekmesinden kilitleme ve şifreleme yapabilirsiniz.

 

[ayarse]

Dağıtımda hala sorun var.
Örnek : F sütunu 39 iken 23-11-5 şeklinde dağıtıyor. Ama 24-10-5 olmalı
F sütunu 34 iken 21-9-4 şeklinde dağıtıyor. 20-10-4 olmalı

Sayfa açıldığında çalışması ile ilgili kodu yapıştırdım ama çalışmadı. Sanırım yerini bilemedim. Açıklarsanız sevinirim. Çalıştığında nasıl olur bilmiyorum ama sayfaya her veri girişinde çalışacak mı? Yoksa sayfayı kapatıp açmak mı gerekecek.
Vakit ayırdığınız ve yardımlarınız için tekrar teşekkürler

 

[YUSUF44]

Yukarda verdiğiniz hangi kuralda bu ifade yer alıyor ki? Ben verdiğiniz kurallardan bu sonucu çıkardım. Hep "ilk sütundan başlamak üzere dağıtması gerekir" ve "ilk sütun 4 olmalı" demiyor muydunuz? Başka bir kural mı var?

Aslında bu dağıtım işinin temel kuralını daha anlamamışım sanıyorum Ben dağıtım için tamsayı formülünü kullanıyorum. (TAMSAYI(A1/7*4) gibi)

Siz neden 39 iken 24 10 5 olması gerektiğini açıklayabilir misiniz, bunun kesin kuralı nedir? Açıklamayı adım adım, "şu işlemi yapıp şunu bulacağız, sonra şunu yapıp şunu bulacağız ve şu nedenden dolayı da sonuç bu çıkacak" şeklinde ayrıntılı anlatırsanız sevinirim.

 

[ayarse]

Tam anlatamadım galiba. Önce 4-2-1 şeklinde dağıtılacak bunda sorun yok. Kesin ve net. G sütunu 4 alırken J sütunu 2 ve M sütunu 1 alacak. Her sayı 7 ye tam bölünemediği içinde bazı sayılarda 6-5-4-3-2-1 şeklinde kalanlar olacak. 5. Yazımda tam emin olamadığımı söyleyerek dağıtımı göstermiştim. Ama daha sonra 11. ve 13. yazıda değişik olarak tekrar sordum. Biraz kafa karıştırdım heralde.
Kalanlarda dağıtım şu şekilde
6 Kalan olduğunda G sütununa 4- J sütununa 2 ve M sütunu 0
5 Kalan olduğunda G sütununa 4- J sütununa 1 ve M sütunu 0
4 Kalan olduğunda G sütununa 4- J sütununa 0 ve M sütunu 0
3 Kalan olduğunda G sütununa 3 -J sütununa 0 ve M sütunu 0
2 Kalan olduğunda G sütununa 2 -J sütununa 0 ve M sütunu 0
1 Kalan olduğunda G sütununa 1- J sütununa 0 ve M sütunu 0
Örneğin açıklaması:
F sütunu 34 iken 21-9-4 şeklinde dağıtıyor 20-10-4 olmalı demiştim
G=4+4+4+4 =16
J=2+2+2+2=8
M=1+1+1+1=4
Toplam 28 olur ve 34 e ulaşmak için 6 kalanımız olur Bu 6 kalanı da ilk olarak G sütununa 4 veririz. J sütuna 2 veririz. Toplamda G=20, J=10 ve M=4 olur.
Örnek : F sütunu 39 iken 23-11-5 şeklinde dağıtıyor. Ama 24-10-5 olmalı da ise
G=4+4+4+4+4=20
J=2+2+2+2+2=10
M=1+1+1+1+1=5
Toplam 35 olur. Kalan 4 olduğu için G satırına ekleriz ve G=24 J=10 ve M=5 olur.

Aslında dağıtım kısmında kod çoğu yerde doğru çalışıyor. Sadece kalan 4 ve ve 6 ise yanlış çalışıyor. 4 kalan olduğunda G sütununa vermesi gereken 1 sayıyı J sütununa
6 kalan olduğunda ise J sütununa vermesi gereken 1 sayıyı G sütununa veriyor. Diğer kalanlarda ise doğru sonuç veriyor. Kafası karışmış sanırım.
Açıklayabildim mi bilmiyorum. Yazdığınız koda baktım ama anlayamayacağım kadar karışık geldi bana, hiçbir şey yapamadım.

 

[YUSUF44]

Şimdi yaptım sanıyorum. Dosya ektedir. Kodlar şu şekle dönüştü:

Sub dağıt()
ssat = Cells(Rows.Count, 1).End(3).Row
For sat = 8 To ssat
Cells(sat, 5) = WorksheetFunction.Sum(Range(Cells(sat, 2), Cells(sat, 4)))
Cells(sat, 6) = WorksheetFunction.RoundUp(Cells(sat, 5) / 3 * (1 + (Cells(sat, 5) - 60) / 100), 0)
If Cells(sat, 6) >= 7 Then
Cells(sat, 7) = WorksheetFunction.RoundDown(Cells(sat, 6) / 7, 0) * 4
Cells(sat, 10) = WorksheetFunction.RoundDown(Cells(sat, 6) / 7, 0) * 2
Cells(sat, 13) = WorksheetFunction.RoundDown(Cells(sat, 6) / 7, 0)

Else
Cells(sat, 7) = WorksheetFunction.Min(4, Cells(sat, 6))
Cells(sat, 10) = WorksheetFunction.Min(Cells(sat, 6) - Cells(sat, 7), WorksheetFunction.Max(2, Cells(sat, 6) - Cells(sat, 7)))
Cells(sat, 13) = WorksheetFunction.Min(Cells(sat, 6) - Cells(sat, 7) - Cells(sat, 10), WorksheetFunction.Max(2, Cells(sat, 6) - Cells(sat, 7) - Cells(sat, 10)))
End If
If Cells(sat, 7) + Cells(sat, 10) + Cells(sat, 13) < Cells(sat, 6) Then
kalan = Cells(sat, 6) - (Cells(sat, 7) + Cells(sat, 10) + Cells(sat, 13))
a = Cells(sat, 7)
b = Cells(sat, 10)
Cells(sat, 7) = Cells(sat, 7) + WorksheetFunction.Min(4, kalan)
kalan = kalan - (Cells(sat, 7) - a)
Cells(sat, 10) = Cells(sat, 10) + WorksheetFunction.Min(2, kalan)
kalan = kalan - (Cells(sat, 10) - b)
Cells(sat, 13) = Cells(sat, 13) + WorksheetFunction.Min(1, kalan)
End If
Cells(sat, 9) = WorksheetFunction.Max(0, Cells(sat, 7) - Cells(sat, 8))
Cells(sat, 12) = WorksheetFunction.Max(0, Cells(sat, 10) - Cells(sat, 11))
Cells(sat, 15) = WorksheetFunction.Max(0, Cells(sat, 13) - Cells(sat, 14))
Next
End Sub

Kod bölümünde Sayfa1'in kodlarına bakarsanız sayfa her açıldığında çalıştıran kodu görebilirsiniz:

Private Sub Worksheet_Activate()
dağıt
End Sub

Sayfa1'de sizin istediğiniz makro var. Sayfa2'de ise kontrolleri daha basitçe yapacağınız makro var. 2. sayfada F sütununa denemek için sayılar girip her düğmeye bastığınızda dağıtımı yapar. Siz de doğru mu idye kontrol edebilirsiniz.

 

[ayarse]

Sayın Yusuf44 ekdeki dosyayı indiremedim. Ama makroya kopyalayınca sorunsuz çalıştı. Beni büyük bir zahmetten kurtardınız. Ellerinize ve emeğinize sağlık.