Kalau begitu, potong saja fungsinya, sekarang logikanya tidak perlu lagi semua result habis dibagi oleh y, pokoknya ambil random yang kurang dari x, lalu jalankan terus sehingga diperoleh hasil terakhir:
Public Function SplitAngka(x As Long, y As Long) 'generate bilangan random yang jumlah semuanya adalah x '------------------------------------------------------ ReDim arr(y) As Long Dim i As Integer Dim maxNilai As Long Randomize maxNilai = x For i = 0 To y - 2 Do While True arr(i) = CLng(Rnd() * (maxNilai - (y - 2) - 1)) + 1 If arr(i) > 0 Then Exit Do ' ambil yang hasilnya lebih besar dari 0 saja Loop maxNilai = maxNilai - arr(i) Next arr(y - 1) = maxNilai - arr(i) 'elemen terakhir adalah sisanya 'test hasil di layar debug '------------------------- Dim runNilai As Long runNilai = 0 For i = 0 To (y - 1) Debug.Print i + 1, arr(i) runNilai = runNilai + arr(i) Next Debug.Print "total : " & runNilai End Function
beberapa result:
?splitangka(10,4) 1 4 2 2 3 2 4 2 total : 10 1 6 2 2 3 1 4 1 total : 10 1 4 2 3 3 1 4 2 total : 10 1 4 2 2 3 1 4 3 total : 10 1 6 2 1 3 1 4 2 total : 10 1 4 2 2 3 1 4 3 total : 10 1 7 2 1 3 1 4 1 total : 10 1 4 2 3 3 1 4 2 total : 10
aksan kurdin
On 9/27/2010 3:25 PM, Erwin Sugiawan wrote:
Kang,
Cara akang lebih baik dari punya ku...thx
akan tetapi , saya kurang memberitahukan persyaratan nya :
1. hasil dari random tidak boleh lebih dari 10000 dan tidak boleh lebih kecil dari 0
2. boleh saja sisa bagi tidak sama dengan NOL, yang penting secara total ada Nilai Awal dan jumlah split tetap
contoh 1000 split 3 hal ini di mungkinkan , mungkin hasil nya 300,300,400
3. nilai hasil random boleh sama tetapi tidak boleh semua nya sama
Best regard
Erwin Sugiawan
Dari: Aksan Kurdin <aksan.kurdin@gmail.com>
Kepada: belajar-access@yahoogroups.com
Terkirim: Sen, 27 September, 2010 13:12:40
Judul: Re: Ada cara lain ? Bls: [belajar-access] Re: mohon bantuan function pecah angka
Dear erwin,
penjelasan lanjutan di email saya berikutnya meneruskan logika-nya.
baiklah saya ulangi, dan kali ini agak panjang.
problem:
pecah bilangan x menjadi y buah, dan setiap pecahan tersebut jika dijumlahkan hasilnya adalah x, dengan syarat x habis di bagi dengan y, dan setiap angka pecah juga habis dibagi dengan y.
model matematika:
input bilangan yang akan di pecah: x di pecah sebanyak : y hasil: angka(1), angka(2), ..., angka(y)
syarat:
logika:
angka(1) + angka(2) + ... + angka(y) = x
setiap operan di sisi kiri harus habis di bagi dengan y, jadi angka(1) bisa kita turunkan menjadi angka'(1) * y, yaitu suatu angka' yang jika dikalikan dengan y dapatnya adalah angka semula :
angka(1) = angka'(1) * yangka(2) = angka'(2) * y...angka(y) = angka'(y) * y
fokus kita sekarang adalah mencari turunannya ini (angka'(1), angka'(2), dst), sehingga persamaannya mejadi:
angka'(1) * y + angka'(2) * y + ... + angka'(y) * y = x
atau disederhanakan menjadi:
(angka'(1) + angka'(2) + ... + angka'(y)) * y = x
disederhanakan lagi:
angka'(1) + angka'(2) + ... + angka'(y) = (x/y)
naaaah ....
kalau sudah sampai sini, pekerjaan tinggal mencari setiap angka'(n) agar jumlahnya semua adalah x/y.
itulah sebabnya x juga harus habis di bagi dengan y.
saya untuk menerangkan langkah selanjutnya by teori mungkin susah, saya coba lewat contoh
x = 1000y = 4
maka kita akan mencari angka(1) .. (angka(4) yang random agar jumlahnya adalah 1000
dari persamaan diatas, kita akan mencari turunannya dulu:
angka'(1) + angka'(2) + angka'(3) + angka'(4) = x/y=> angka'(1) + angka'(2) + angka'(3) + angka'(4) = 1000/4=> angka'(1) + angka'(2) + angka'(3) + angka'(4) = 250
kita punya slot 4 buah yang jika dijumlahkan semua menjadi 250
slot pertama angka'(1) boleh berisi angka random dengan batasan maksimum adalah 247, karena kalau dia maksimum, berarti slot yang lain adalah minimum, yaitu 1:
247 + 1 + 1 + 1 = 250
misalnya jika angka'(1) random di peroleh 97, maka mencari angka sisanya :
97 + angka'(2) + angka'(3) + angka'(4) = 250=> angka'(2) + angka'(3) + angka'(4) = 250 - 97=> angka'(2) + angka'(3) + angka'(4) = 153
dengan cara yang sama, mencari angka'(2) batasan random maksimumnya adalah 153 - 2 (yaitu 2 slot sisa dianggap berisi 1), jadinya 151.
misalkan diperoleh angka random 60, maka persamaan menjadi:
60 + angka'(3) + angka'(4) = 153=> angka'(3) + angka'(4) = 153 - 60 = 93
dengan cara yang sama pula, maka angka random slot tiga tidak boleh melebihi 93-1 = 92. misalnya diperoleh randomnya adalah 50, maka selanjutnya angka random terakhir tidak perlu di random lagi, karena ia pasti merupakan sisa dari 250 di kurangi angka2 sebelumnya.
hasilnya diperoleh:
angka'(1) = 97 angka'(2) = 60 angka'(3) = 50 angka'(4) = 250 - 97 - 60 - 50 = 43
dengan demikian angka yang dibutuhkan, tinggal mengalikan setiap angka' dengan nilai y, yaitu 4:
angka(1) = angka'(1) * 4 = 97 * 4 = 388 angka(2) = angka'(2) * 4 = 60 * 4 = 240 angka(3) = angka'(3) * 4 = 50 * 4 = 200 angka(4) = angka'(4) * 4 = 43 * 4 = 172
tadaa.... anda telah mendapatkan 4 angka dengan jumlah semuanya adalah 1000.
dengan cara yang sama, jika saya masukkan input x = 1000 dan y = 20, saya peroleh:
1 28 560 2 3 60 3 1 20 4 1 20 5 1 20 6 1 20 7 1 20 8 1 20 9 1 20 10 1 20 11 1 20 12 1 20 13 1 20 14 1 20 15 1 20 16 1 20 17 1 20 18 1 20 19 1 20 20 2 40 total : 1000
dan, syarat dari anda yang tidak boleh angka sama sepertinya susah di penuhi .........
karena semakin besar pembaginya, maka pasti akan menghasilkan angka yang sama berulang2, kecuali mau di olah manual lagi, dari yang sudah dapat disebar-sebarkan ke yang lain untuk memperoleh angka yang unik.
berikut fungsi yang saya pergunakan:
Public Function SplitAngka(x As Long, y As Long) 'cek syarat pertama, x harus habis dibagi y If x Mod y <> 0 Then Beep MsgBox "Tidak bisa dijalankan karena " & x & " tidak habis dibagi dengan " & y Exit Function End If 'generate bilangan random yang jumlah semuanya adalah x '------------------------------------------------------ ReDim arr(y) As Long Dim i As Integer Dim maxNilai As Long Randomize maxNilai = x / y For i = 0 To y - 2 ' looping sejumlah y - 1 saja, karena elemen terakhir berupa sisanya ' ingat, array di mulai dari 0, jadi loop dari 0 to y - 1 ' karena elemen terakhir tidak di loop, maka jadinya loop dari 0 to y - 2 Do While True 'untuk memperoleh nilai random di antara nilai a dan b gunakan fungsi: 'CLng(Rnd() * (a-b) + a) arr(i) = CLng(Rnd() * (maxNilai - (y - 2) - 1)) + 1 If arr(i) > 0 Then Exit Do ' ambil yang hasilnya lebih besar dari 0 saja Loop maxNilai = maxNilai - arr(i) Next arr(y - 1) = maxNilai - arr(i) 'elemen terakhir adalah sisanya 'test hasil di layar debug '------------------------- Dim runNilai As Long runNilai = 0 For i = 0 To (y - 1) Debug.Print i + 1, arr(i), arr(i) * y runNilai = runNilai + arr(i) Next Debug.Print "total : " & runNilai * y End Function
On 9/27/2010 10:35 AM, Erwin Sugiawan wrote:kang, dan para acceser,
just reminder ..kasus nya sbb :
aku mau split angka X menjadi Y kali tp hasil Y kali nya tidak boleh sama semua, contoh
split 1000 menjadi 4x ....... hasil nya tidak boleh 250 ,250 250 dan 250
harus angka random .......dan total angka random itu tetap 1000
karena nila pembagi bisa lebih dari 1 dan hasil random bisa menghasilkan nilai yang sama dengan nilai awal maka nilai awal saya bagi dulu dengan pembagi. function nya sbb
Function x(NilaiAwal As Double, pembagi As Double) As Double
Dim i As Integer
Dim NA As Integer
Dim Hasil
Randomize
NA = NilaiAwal
For i = 1 To pembagi - 1
Hasil = Int(((NA / pembagi) * Rnd) + 1)
NA = NA - Hasil
Debug.Print Hasil
Next i
x = NA
End Function
Best regard
kira2 ada cara lain ??????
Erwin Sugiawan
__._,_.___
No comments:
Post a Comment