Option Explicit
Sub randomNum()
Dim i&, k&, rng, tota&, mNUm As Double, r, s, cong As Double
Dim res1(), res2(), res3(), dic As Object
Set dic = CreateObject("Scripting.Dictionary")
On Error Resume Next
'Dung InputBox neu gia tri tong nay thay doi
tota = 5263509 'InputBox("Ban muon tong gia tri cot 3 la bao nhieu?")
On Error GoTo 0
rng = Range("E2:F" & Cells(Rows.Count, "E").End(xlUp).Row - 1).Value
If Not IsNumeric(tota) Or tota < UBound(rng) Then
MsgBox "Gia tri nay khong hop le! Hay thu lai."
Exit Sub
End If
ReDim res1(1 To UBound(rng)), res2(1 To UBound(rng)), res3(1 To UBound(rng))
mNUm = tota / UBound(rng)
'Tao gia tri ngau nhien tu 30K den 40K va luu vao res1
Randomize
For i = 1 To Int(UBound(rng) / 2)
r = Int(Rnd * (40000 - 30000)) + 30000
k = k + 1: res1(k) = r: cong = cong + res1(k)
k = k + 1: res1(k) = Int(mNUm * 2) - r: cong = cong + res1(k)
Next
'Dua gia tri cua dong cuoi cung vao dong cuoi cung
Select Case k
Case (UBound(rng) - 1)
k = k + 1: res1(k) = tota - cong
Case Else
res1(k) = tota - cong + res1(k)
End Select
'Sap xep lai ngau nhien cho cot 3
For i = 1 To UBound(res1)
Do
r = Int(Rnd * UBound(res1)) + 1
If Not dic.exists(r) Then
dic.Add r, ""
Exit Do
End If
Loop
res3(i) = res1(r): res1(r) = ""
Next
'Tao gia tri ngau nhien cho cot 2 và cot 1
For i = 1 To UBound(res3)
Do
r = Int(Rnd * (18000 - 15000)) + 15000
s = r + res3(i)
If s >= 45000 And s <= 60000 Then Exit Do
Loop
res1(i) = s: res2(i) = r
Next
'Dan ket qua vao sheet
Range("G2").Resize(UBound(res1), 1).Value = WorksheetFunction.Transpose(res1)
Range("H2").Resize(UBound(res2), 1).Value = WorksheetFunction.Transpose(res2)
Range("J2").Resize(UBound(res3), 1).Value = WorksheetFunction.Transpose(res3)
End Sub
