Xin giải pháp: Nhập tổng lượng vào 1 ô, nó tự chia lượng ra các ô bên dưới·

[Việt Đức Phạm]

Chào anh chị em có trường hợp này nhờ anh chị hỗ trợ giúp.
Mình muốn nhập một lượng vào ô Tổng bên trên, bảng tính tự động chia lượng cho mình vào các ô bên dưới. Lượng bên dưới được chia random ( không phải là số liền kề liên tiếp 1 2 3), Mình xin cảm ơn các bạn

 

[CHAOQUAY]

@ Thớt: Tham khảo 1 cách phân bổ theo solver
- Chạy sub abc để hoán vị
- Chạy solver để xem kết quả

 

[cantl]

Cho phép ham vui xíu nha:

Function SoTuDong(ByVal Tien As Long, Dong As Integer) As Variant
Dim fNum As Integer, TB As Long, J As Integer, Tong As Integer

TB = Tien / Dong:                           Randomize
ReDim KQ(1 To Dong, 1 To 1)
Do
    J = J + 1:
    If J = Dong Then
        KQ(Dong, 1) = Tien - Tong:          Exit Do
    End If
    fNum = J + TB * Rnd()
    KQ(J, 1) = fNum \ 1
    Tong = Tong + KQ(J, 1)
Loop
SoTuDong = KQ()
End Function

Nhưng số lít cần nhập nên gấp 6 lần trở lên so với số dòng mới đẹp mảng nhận được

Tại sao code của bác ấn F9 nó không nhảy giá trị như code của bác HUONGHCKT như trên vậy nhỉ? Là lạ bác ạ!

solver

Solver có vẻ không hay vì nó cho cảm giác không phải random thực sự, nó dồn to vào 1 chỗ, phần còn lại bị teo nhỏ nhỉ.

 

[CHAOQUAY]

Tại sao code của bác ấn F9 nó không nhảy giá trị như code của bác HUONGHCKT như trên vậy nhỉ? Là lạ bác ạ!


Solver có vẻ không hay vì nó cho cảm giác không phải random thực sự, nó dồn to vào 1 chỗ, phần còn lại bị teo nhỏ nhỉ.

File này chủ yếu là test solver có thể tìm được kết quả yêu cầu hay không nên để đơn giản vậy chạy cho nhanh.
Nếu cần, có thể bổ sung điều kiện biên để yêu cầu solver kết quả khác nhưng khi đó có thể sẽ chạy lâu hơn.

Bài này tổng = 100, số phần tử = 10 nên liệt kê số tới 55, solver nó cứ tìm tổ hợp nào gần nhất, xong là dừng nên kết quả trả về như vậy.
Nếu bạn xóa 1 vài dòng trong số liệu nguồn, sẽ thấy solver trả về kết quả khác

 

[VetMini]

Function PhanBo(ByVal tong As Long, ByVal phan As Long)
' ham phan bo so luong "tong" theo so luong "phan"
' output: mot mang "phan" phan tu; dieu kien: moi phan tu duoc phan bo it nhat 1
'
If tong < phan Then
PhanBo = "Khong du luong de phan bo"
Exit Function
End If
Randomize
ReDim a(1 To phan) As Long
For i = 1 To phan
a(i) = Application.RandBetween(1, 1000000)
tongA = tongA + a(i)
Next i
tongA = (tong - phan) / tongA ' tinh he so cho moi phan tu
For i = 1 To phan
a(i) = Int(a(i) * tongA) + 1 ' cong 1 de bao dam moi phan tu >= 1
tong = tong - a(i)
Next i
If tong > 0 Then ' thanh ly so le do sai so tinh toan
i = Application.RandBetween(1, phan)
a(i) = a(i) + tong
End If
PhanBo = a
End Function

Hàm trả về một mảng dọc.
Để sử dụng:
- select 10 ô liên tiếp
- gõ =PhanBo(số lượng, 10)
- gõ Ctrl+Shift+Enter

Giải thuật được tính theo kiểu để tránh tối đa trường hợp chênh lệch nhiều quá (tránh tối đa là đủ rồi, đã random thì tránh 100% hơi khó.)

 

[HieuCD]

Function PhanBo(ByVal tong As Long, ByVal phan As Long)
' ham phan bo so luong "tong" theo so luong "phan"
' output: mot mang "phan" phan tu; dieu kien: moi phan tu duoc phan bo it nhat 1
'
If tong < phan Then
PhanBo = "Khong du luong de phan bo"
Exit Function
End If
Randomize
ReDim a(1 To phan) As Long
For i = 1 To phan
a(i) = Application.RandBetween(1, 1000000)
tongA = tongA + a(i)
Next i
tongA = (tong - phan) / tongA ' tinh he so cho moi phan tu
For i = 1 To phan
a(i) = Int(a(i) * tongA) + 1 ' cong 1 de bao dam moi phan tu >= 1
tong = tong - a(i)
Next i
If tong > 0 Then ' thanh ly so le do sai so tinh toan
i = Application.RandBetween(1, phan)
a(i) = a(i) + tong
End If
PhanBo = a
End Function

Hàm trả về một mảng dọc.
Để sử dụng:
- select 10 ô liên tiếp
- gõ =PhanBo(số lượng, 10)
- gõ Ctrl+Shift+Enter

Giải thuật được tính theo kiểu để tránh tối đa trường hợp chênh lệch nhiều quá (tránh tối đa là đủ rồi, đã random thì tránh 100% hơi khó.)

Chỉ điều chỉnh 1 giá trị có thể làm kết quả chênh lệch không đều
= PhanBo(14, 10)