Bölünebilme kuralını bul rastgele periyodlara yaz

[pcDeviL]

Merhaba,

Ekli dosyada belirttiğim iş ile ilgili desteğiniz ricadır.

Periyodlarda küçük tutarlar olmaması adına böyle bir çalışma yapıyorum.

BÖLÜNEBİLME KURALLARI
N5 0 ila 2000 ara sı ilse dokunma ve P1 ile P10 arası bir yere yapıştır

N5 2500 ve 5000 arası ise 2 ye böl ve P1 ila P10 a bölünen tutarları yaz

N5 5000 ve 10 000 arası ise 3 e böl ve rastgele P1 P10 arası yaz

10.000 ila 50000 arası ise 4 e böl ve P1 ile P10 arası rastgele yaz.


Saygılarımla

 

[Ömer BARAN]

Merhaba.
Yanlış anlamadıysam istediğiniz işlemi aşağıdaki kod ile gerçekleştirebilirsiniz.
.

[FONT="Arial Narrow"]Sub BÖL_DAĞIT()
Range("R4:AA" & [A65536].End(3).Row).ClearContents
For satır = 4 To [A65536].End(3).Row
    If Cells(satır, 14) >= 0 And Cells(satır, 14) <= 2500 Then
        bölen = 1
            ElseIf Cells(satır, 14) > 2500 And Cells(satır, 14) <= 5000 Then
                bölen = 2
                    ElseIf Cells(satır, 14) > 5000 And Cells(satır, 14) <= 10000 Then
                    bölen = 3
                ElseIf Cells(satır, 14) > 10000 And Cells(satır, 14) <= 50000 Then
            bölen = 4
         ElseIf Cells(satır, 14) > 50000 Then
       bölen = 5
   End If
değer = Cells(satır, 14) / bölen
    If değer > 0 Then
        For brn = 1 To bölen
10:     sut = WorksheetFunction.RandBetween(18, 27)
            If Cells(satır, sut) <> "" Then GoTo 10
            Cells(satır, sut) = değer
        Next
    End If
Next: Columns("R:AA").AutoFit: Columns("R:AA").NumberFormat = "#,##0.00": MsgBox "İŞLEM TAMAM..."
End Sub[/FONT]

 

[pcDeviL]

Emeğiniz için teşekkürler Ömer bey,

Mantıklı sonuçlar dönmedi.

Saygılarımla.

 

[Ömer BARAN]

Merhaba.

Önceki cevabımda yaptığım hatayı düzelterek kod'u güncelledim.
Kırmızı kısmı düzeltmeniz yeterli.
.

 

[pcDeviL]

Ömer Bey tekrar merhaba,

Yaptığınız iş çalışıyor teşekkür ediyorum. Ama ifademde bir sıkıntı oldu sanırım P1 ve P10 arası toplam N sütunundaki rakamları vermeli. Sizde 5 bini 2 ye bölüp 2.500 ü rastgele atıyor ama bir tane daha atamalı yani toplam 5 bin etmeli.

Bu yapılabiliyorsa süper.

Ama gerçekten elinize sağlık tekrar tekrar teşekkürler.

 

[Ömer BARAN]

Ben hedeflenen işlemi (N sütunundaki değerin dilimlere göre değişen adette hücreye bölünerek dağıtılacağı)
tam anlayamamışım demekki, kod'u tekrar güncelledim,
sayfayı yenileyerek önceki cevabımı kontrol edip yeni kod'u kullanabilirsiniz.

 

[pcDeviL]

Muazzam.. Çok ama çok teşekkürler..

 

[Ömer BARAN]

İşlemlerinizde gördüğüm eksiklik şudur;

değer 50.000'den büyükse seçeneği açıkta duruyor ve bu durumda bir önceki satır için
bölen katsayısı neyse ona göre dağıtım gerçekleşiyor.

İsterseniz aşağıdaki kırmızı satırların arasına mavi olanları ekleyin ki
50.000'den büyük sayılar da 5 hücreye gibi daha anlamlı bir dağıtıma tabi tutulmuş olsun.

[FONT="Arial Narrow"][COLOR="red"]            bölen = 4[/COLOR]
[COLOR="Blue"]         ElseIf Cells(satır, 14) > 50000 Then
       bölen = 5
[/COLOR][COLOR="Red"]    End If
değer = Cells(satır, 14) / bölen[/COLOR][/FONT]

Son olarak da sütun genişliklerini ve sayı biçimini ayarlamak için, aşağıdaki kırmızı satırı, yine mavisiyle değiştirin.

[FONT="Arial Narrow"][COLOR="red"]Next: MsgBox "İŞLEM TAMAM..."[/COLOR]
[COLOR="Blue"]Next: Columns("R:AA").AutoFit: Columns("R:AA").NumberFormat = "#,##0.00": MsgBox "İŞLEM TAMAM..."[/COLOR][/FONT]

 

[pcDeviL]

VBA'ya tekrar hayran kaldım.

For, degisken, if her dilde olsada bana VBA nın söz dizimi çok soğuk geliyor.

Tam istediğim gibi olmuş Ömer bey umarım bir çok arkadaşında işine yarar.

 

[Ömer BARAN]

Merhaba.

Güle güle kullanın.
Kullanmak isteyen biri olursa hazır olsun diye, ilk kod cevabımı son haline göre güncelledim.

Excel belgesiyle VBA ekranını monitörünüzde aynı anda görebilecek şekilde konumlandırın ve
VBA ekranı aktif iken, F8 tuşuna aralıklarla basarak kod'un hangi satırında,
tam olarak hangi işlemin gerçekleştiğini izleyin, sarı zeminli satır bir sonraki işlem satırıdır.

İstediğiniz anda F8 tuşuna basmayı bırakıp fareyle, satır/bölen/sut değişkenlerinin üzerine gelerek,
o işlem anında aldığı değeri görebilir, For...Next döngüsünü tam olarak anlamış olursunuz.

Seveceğinizden ve denemeler yapacağınızdan eminim.
.

 

[pcDeviL]

Deneyeceğim Ömer bey,

Saygılar.