Nhờ giúp đỡ code phân bổ số lượng theo không vượt quá con số cho trước?

Liên hệ QC

Ngày mai trời lại sáng

Thành viên thường trực
Tham gia
4/7/21
Bài viết
338
Được thích
139
Chào mọi người,
Đầu vào em có số liệu phân bổ D5 và số liệu tại dòng ban đầu "B7:K7",nhờ mọi người code giúp em để ra được kết quả theo B8:K8 với.

1630209011355.png
 

File đính kèm

  • Book1.xlsx
    10.5 KB · Đọc: 23
Chào mọi người,
Đầu vào em có số liệu phân bổ D5 và số liệu tại dòng ban đầu "B7:K7",nhờ mọi người code giúp em để ra được kết quả theo B8:K8 với.
Chưa rõ ràng.

Từ B8 đến K8 là ngẫu nhiên? Có ràng buộc gì không? Ví dụ như:

- Luôn bằng hoặc lớn hơn số phía trên nó?

-Nhỏ hơn, bằng lớn hơn số phía trên nó?

-Tối thiểu và tối đa được phép?

...
 
Chưa rõ ràng.

Từ B8 đến K8 là ngẫu nhiên? Có ràng buộc gì không? Ví dụ như:

- Luôn bằng hoặc lớn hơn số phía trên nó?

-Nhỏ hơn, bằng lớn hơn số phía trên nó?

-Tối thiểu và tối đa được phép?

...
Cảm ơn bác đã xem bài và cho ý kiến,
B8:K8 sẽ lấy theo B7:K7, tuy nhiên do số lượng phân bổ là 1600 số lượng này sẽ phân bổ bắt đầu vào B8 cho đến hết 1600 với điều kiện chỉ nhận phần thêm sao cho tổng thêm + số ban đầu không quá 1000.
Ví dụ:
B7=572 => 1000-572=428 (con số B8 phải nhận thêm)
Số lượng phân bổ còn lại nếu còn dữ sẽ phân bổ tiếp: = 1600-428=1172 phân bổ tiếp cho C8 cứ như vậy cho đến hế 1600 và số lượng max=1000, khi hết 1600 số các số sau không nhận được sự phân bổ sẽ lấy chính số ban đầu.
 
Chào mọi người,
Đầu vào em có số liệu phân bổ D5 và số liệu tại dòng ban đầu "B7:K7",nhờ mọi người code giúp em để ra được kết quả theo B8:K8 với.

View attachment 264988
Bạn thử dùng thủ tục này đúng không nhé.
PHP:
Sub PhanBo()
    Dim arrTemp
    Dim c As Byte
    Dim lngSoCot As Long
    Dim shData As Worksheet
    Dim dblSoMax As Double, dblSoPhanBo As Double, dblThayDoi As Double
    Set shData = Sheets("Sheet1")
    dblSoPhanBo = shData.Range("D5").Value
    arrTemp = shData.Range("B7:K7").Value
    dblSoMax = 1000
    dblTotal = WorksheetFunction.Sum(arrTemp)
    dblThayDoi = dblTotal + dblSoPhanBo
    lngSoCot = UBound(arrTemp, 2)
    For c = 1 To lngSoCot
        arrTemp(1, c) = dblSoMax
        dblTotal = WorksheetFunction.Sum(arrTemp)
        If dblTotal > dblThayDoi Then
            arrTemp(1, c) = dblSoMax - (dblTotal - dblThayDoi)
            Exit For
        End If
    Next
    shData.Range("B8:K8").Value = arrTemp
End Sub
 
Bạn thử dùng thủ tục này đúng không nhé.
PHP:
Sub PhanBo()
    Dim arrTemp
    Dim c As Byte
    Dim lngSoCot As Long
    Dim shData As Worksheet
    Dim dblSoMax As Double, dblSoPhanBo As Double, dblThayDoi As Double
    Set shData = Sheets("Sheet1")
    dblSoPhanBo = shData.Range("D5").Value
    arrTemp = shData.Range("B7:K7").Value
    dblSoMax = 1000
    dblTotal = WorksheetFunction.Sum(arrTemp)
    dblThayDoi = dblTotal + dblSoPhanBo
    lngSoCot = UBound(arrTemp, 2)
    For c = 1 To lngSoCot
        arrTemp(1, c) = dblSoMax
        dblTotal = WorksheetFunction.Sum(arrTemp)
        If dblTotal > dblThayDoi Then
            arrTemp(1, c) = dblSoMax - (dblTotal - dblThayDoi)
            Exit For
        End If
    Next
    shData.Range("B8:K8").Value = arrTemp
End Sub
Code chạy ra đúng kết quả em muốn, cảm ơn Mod. Em đang tìm hiểu vòng lặp Do , Mod có thể chỉ cho em thêm cách dùng Do được không thay vì dùng For.
Em cũng muốn tham khảo thêm ý tưởng khác để học hỏi, bác nào có thêm ý tưởng cho em tham khảo thêm nhé.
 
Bạn thử dùng thủ tục này đúng không nhé.
PHP:
Sub PhanBo()
    Dim arrTemp
    Dim c As Byte
    Dim lngSoCot As Long
    Dim shData As Worksheet
    Dim dblSoMax As Double, dblSoPhanBo As Double, dblThayDoi As Double
    Set shData = Sheets("Sheet1")
    dblSoPhanBo = shData.Range("D5").Value
    arrTemp = shData.Range("B7:K7").Value
    dblSoMax = 1000
    dblTotal = WorksheetFunction.Sum(arrTemp)
    dblThayDoi = dblTotal + dblSoPhanBo
    lngSoCot = UBound(arrTemp, 2)
    For c = 1 To lngSoCot
        arrTemp(1, c) = dblSoMax
        dblTotal = WorksheetFunction.Sum(arrTemp)
        If dblTotal > dblThayDoi Then
            arrTemp(1, c) = dblSoMax - (dblTotal - dblThayDoi)
            Exit For
        End If
    Next
    shData.Range("B8:K8").Value = arrTemp
End Sub


Mình chạy thử thấy chưa khớp thì phải?

1630215158079.png
 
Code chạy ra đúng kết quả em muốn, cảm ơn Mod. Em đang tìm hiểu vòng lặp Do , Mod có thể chỉ cho em thêm cách dùng Do được không thay vì dùng For.
Em cũng muốn tham khảo thêm ý tưởng khác để học hỏi, bác nào có thêm ý tưởng cho em tham khảo thêm nhé.
Dùng Do ... Loop hay For ... Next đều như nhau có thời gian thực hiện như nhau, miễn là mình biết khi nào dùng Do và khi nào dùng For cho nó hợp lý. Thế bạn có thể cho biết vì sao phải dùng Do hay không?
 
Dùng Do ... Loop hay For ... Next đều như nhau có thời gian thực hiện như nhau, miễn là mình biết khi nào dùng Do và khi nào dùng For cho nó hợp lý. Thế bạn có thể cho biết vì sao phải dùng Do hay không?
Em rất thích câu hỏi này của Mod, không phải là do được 1 đòi 2 mà em muốn tìm hiểu thêm về các xử lý để tăng thêm kỹ năng tư duy.
Lý do em thích dùng Do là qua tìm hiểu em thấy Do sẽ lặp đến khi nào thỏa mãn diều kiện thì tự kết thúc,còn với dùng For thì Exit For khi thỏa mãn.
Em hiểu về thời gian là như nhau nếu có chênh cũng không để ý nhiều, nhưng nếu dùng Do sẽ không cần Exit?
Chỉ là em đang tìm hiểu Do nên muốn tham khảo thêm về cách dùng Do.
 
mình test nó cũng bị như vậy, không biết bị gì?View attachment 264999
Thứ nhất: ô L9 bạn đã ghi sai công thức, công thức đúng phải là: =L8-L7 (so sánh số chênh lệch).

Thứ hai: Con số 16.000 không bao giờ phân bố đủ cho 10 ô vì tổng số chỉ được cao lắm là 10.000. Bạn nên thay đổi số max của mỗi ô ít nhất cũng là 1.600 may ra mới phân bố đủ.
Bài đã được tự động gộp:

Em rất thích câu hỏi này của Mod, không phải là do được 1 đòi 2 mà em muốn tìm hiểu thêm về các xử lý để tăng thêm kỹ năng tư duy.
Lý do em thích dùng Do là qua tìm hiểu em thấy Do sẽ lặp đến khi nào thỏa mãn diều kiện thì tự kết thúc,còn với dùng For thì Exit For khi thỏa mãn.
Em hiểu về thời gian là như nhau nếu có chênh cũng không để ý nhiều, nhưng nếu dùng Do sẽ không cần Exit?
Chỉ là em đang tìm hiểu Do nên muốn tham khảo thêm về cách dùng Do.
Ai nói với bạn là dùng DO mà không có Exit? Nếu không có Exit hoặc thỏa điều kiện (While/Until) thì nó Do suốt cho đến khi tắt Excel à?
 
Thứ nhất: ô L9 bạn đã ghi sai công thức, công thức đúng phải là: =L8-L7 (so sánh số chênh lệch).

Thứ hai: Con số 16.000 không bao giờ phân bố đủ cho 10 ô vì tổng số chỉ được cao lắm là 10.000. Bạn nên thay đổi số max của mỗi ô ít nhất cũng là 1.600 may ra mới phân bố đủ.
Bài đã được tự động gộp:


Ai nói với bạn là dùng DO mà không có Exit? Nếu không có Exit hoặc thỏa điều kiện (While/Until) thì nó Do suốt cho đến khi tắt Excel à?
À à, em phát biểu nhầm sorry sorry Mod ý em là nó tự thoát khi thỏa mãn điều kiện mà không phải thêm câu lệnh Exit giống như Exit For ấy.
Ôi thôi nếu lần này có phát biểu sai nữa thì thôi Mod kệ đi, vì em chưa hiểu chưa sử dụng Do.
 
À à, em phát biểu nhầm sorry sorry Mod ý em là nó tự thoát khi thỏa mãn điều kiện mà không phải thêm câu lệnh Exit giống như Exit For ấy.
Ôi thôi nếu lần này có phát biểu sai nữa thì thôi Mod kệ đi, vì em chưa hiểu chưa sử dụng Do.
Bạn nhìn code này xem nó có cần Exit không nhé!

PHP:
Sub PhanBo()
    Dim arrTemp
    Dim c As Byte
    Dim lngSoCot As Long
    Dim shData As Worksheet
    Dim dblSoMax As Double, dblSoPhanBo As Double, dblThayDoi As Double
    Set shData = Sheets("Sheet1")
    dblSoPhanBo = shData.Range("D5").Value
    arrTemp = shData.Range("B7:K7").Value
    dblSoMax = 1000
    dblTotal = WorksheetFunction.Sum(arrTemp)
    dblThayDoi = dblTotal + dblSoPhanBo
    lngSoCot = UBound(arrTemp, 2)
    Do
        c = c + 1
        arrTemp(1, c) = dblSoMax
        dblTotal = WorksheetFunction.Sum(arrTemp)
        If dblTotal > dblThayDoi Then
            arrTemp(1, c) = dblSoMax - (dblTotal - dblThayDoi)
            Exit Do
        End If
    Loop
    shData.Range("B8:K8").Value = arrTemp
End Sub
 
Bạn nhìn code này xem nó có cần Exit không nhé!

PHP:
Sub PhanBo()
    Dim arrTemp
    Dim c As Byte
    Dim lngSoCot As Long
    Dim shData As Worksheet
    Dim dblSoMax As Double, dblSoPhanBo As Double, dblThayDoi As Double
    Set shData = Sheets("Sheet1")
    dblSoPhanBo = shData.Range("D5").Value
    arrTemp = shData.Range("B7:K7").Value
    dblSoMax = 1000
    dblTotal = WorksheetFunction.Sum(arrTemp)
    dblThayDoi = dblTotal + dblSoPhanBo
    lngSoCot = UBound(arrTemp, 2)
    Do
        c = c + 1
        arrTemp(1, c) = dblSoMax
        dblTotal = WorksheetFunction.Sum(arrTemp)
        If dblTotal > dblThayDoi Then
            arrTemp(1, c) = dblSoMax - (dblTotal - dblThayDoi)
            Exit Do
        End If
    Loop
    shData.Range("B8:K8").Value = arrTemp
End Sub
Ô vậy là vẫn phải dùng thêm Exit, chắc là phải vậy rồi, em không hiểu lắm chỉ là muốn tìm hiểu thêm thôi.
Ví dụ như câu lệnh sau với Do tự nó kết thúc khi đụng đến giá trị Max=5
Mã:
Sub test_doWhile()
    Dim counter As Integer
    counter = 1
    Do While counter < 5
      MsgBox "Gia tri hien tai cua counter la: " & counter
      counter = counter + 1
    Loop
End Sub
 
Ô vậy là vẫn phải dùng thêm Exit, chắc là phải vậy rồi, em không hiểu lắm chỉ là muốn tìm hiểu thêm thôi.
Ví dụ như câu lệnh sau với Do tự nó kết thúc khi đụng đến giá trị Max=5
Mã:
Sub test_doWhile()
    Dim counter As Integer
    counter = 1
    Do While counter < 5
      MsgBox "Gia tri hien tai cua counter la: " & counter
      counter = counter + 1
    Loop
End Sub
Trường hợp đơn giản thì bạn có thể gán chúng trên While/Until được, còn phức tạp sao mà gán được!

Trong trường hợp dùng Do ở cái bài #8 mà bạn gì đó thắc mắc, nếu nó không thỏa điều kiện thì dùng DO nó chạy tới sáng luôn vì thế ta phải cho nó một điểm dừng.

Mã:
    lngSoCot = UBound(arrTemp, 2)
    Do Until c = lngSoCot
        c = c + 1
        arrTemp(1, c) = dblSoMax
        dblTotal = WorksheetFunction.Sum(arrTemp)
        If dblTotal > dblThayDoi Then
            arrTemp(1, c) = dblSoMax - (dblTotal - dblThayDoi)
            Exit Do
        End If
    Loop

Đó là: Do Until c = lngSoCot

Nếu không nó chạy hết cột trong mảng nó sẽ báo lỗi.
 
Trường hợp đơn giản thì bạn có thể gán chúng trên While/Until được, còn phức tạp sao mà gán được!

Trong trường hợp dùng Do ở cái bài #8 mà bạn gì đó thắc mắc, nếu nó không thỏa điều kiện thì dùng DO nó chạy tới sáng luôn vì thế ta phải cho nó một điểm dừng.

Mã:
    lngSoCot = UBound(arrTemp, 2)
    Do Until c = lngSoCot
        c = c + 1
        arrTemp(1, c) = dblSoMax
        dblTotal = WorksheetFunction.Sum(arrTemp)
        If dblTotal > dblThayDoi Then
            arrTemp(1, c) = dblSoMax - (dblTotal - dblThayDoi)
            Exit Do
        End If
    Loop

Đó là: Do Until c = lngSoCot

Nếu không nó chạy hết cột trong mảng nó sẽ báo lỗi.
Nhờ Mod xem giúp em 3 sub này em chạy với dữ liệu sau kết quả lại sai:
Mã:
Option Explicit
Sub PhanBo()
    Dim arrTemp
    Dim c As Byte
    Dim lngSoCot As Long
    Dim shData As Worksheet
    Dim dblSoMax As Double, dblSoPhanBo As Double, dblThayDoi As Double, dblTotal As Boolean
    Set shData = Sheets("Sheet1")
    dblSoPhanBo = shData.Range("D5").Value
    arrTemp = shData.Range("B7:K7").Value
    shData.Range("B8:K8").ClearContents
    dblSoMax = 1000
    dblTotal = WorksheetFunction.Sum(arrTemp)
    dblThayDoi = dblTotal + dblSoPhanBo
    lngSoCot = UBound(arrTemp, 2)
    For c = 1 To lngSoCot
        arrTemp(1, c) = dblSoMax
        dblTotal = WorksheetFunction.Sum(arrTemp)
        If dblTotal > dblThayDoi Then
            arrTemp(1, c) = dblSoMax - (dblTotal - dblThayDoi)
            Exit For
        End If
    Next
    shData.Range("B8:K8").Value = arrTemp
End Sub
Sub PhanBo2()
    Dim arrTemp
    Dim c As Byte
    Dim lngSoCot As Long
    Dim shData As Worksheet
    Dim dblSoMax As Double, dblSoPhanBo As Double, dblThayDoi As Double, dblTotal As Boolean
    Set shData = Sheets("Sheet1")
    dblSoPhanBo = shData.Range("D5").Value
    arrTemp = shData.Range("B7:K7").Value
    shData.Range("B8:K8").ClearContents
    dblSoMax = 1000
    dblTotal = WorksheetFunction.Sum(arrTemp)
    dblThayDoi = dblTotal + dblSoPhanBo
    lngSoCot = UBound(arrTemp, 2)
    Do
        c = c + 1
        
        arrTemp(1, c) = dblSoMax 'Loi: Subscript out of range
        dblTotal = WorksheetFunction.Sum(arrTemp)
        If dblTotal > dblThayDoi Then
            arrTemp(1, c) = dblSoMax - (dblTotal - dblThayDoi)
            Exit Do
        End If
    Loop
    shData.Range("B8:K8").Value = arrTemp
End Sub

Sub PhanBo3()
    Dim arrTemp
    Dim c As Byte
    Dim lngSoCot As Long
    Dim shData As Worksheet
    Dim dblSoMax As Double, dblSoPhanBo As Double, dblThayDoi As Double, dblTotal As Boolean
    Set shData = Sheets("Sheet1")
    dblSoPhanBo = shData.Range("D5").Value
    arrTemp = shData.Range("B7:K7").Value
    shData.Range("B8:K8").ClearContents
    dblSoMax = 1000
    dblTotal = WorksheetFunction.Sum(arrTemp)
    dblThayDoi = dblTotal + dblSoPhanBo
    lngSoCot = UBound(arrTemp, 2)
    Do Until c = lngSoCot
        c = c + 1
        arrTemp(1, c) = dblSoMax
        dblTotal = WorksheetFunction.Sum(arrTemp)
        If dblTotal > dblThayDoi Then
            arrTemp(1, c) = dblSoMax - (dblTotal - dblThayDoi)
            Exit Do
        End If
    Loop
    shData.Range("B8:K8").Value = arrTemp
End Sub
1630222079992.png
 

File đính kèm

  • PhanBo.xlsm
    21.8 KB · Đọc: 5
Code chạy ra đúng kết quả em muốn, cảm ơn Mod. Em đang tìm hiểu vòng lặp Do , Mod có thể chỉ cho em thêm cách dùng Do được không thay vì dùng For.
Em cũng muốn tham khảo thêm ý tưởng khác để học hỏi, bác nào có thêm ý tưởng cho em tham khảo thêm nhé.
Chạy solver trong file đính kèm
 

File đính kèm

  • PhanBo.xlsm
    21.5 KB · Đọc: 13
Nhờ Mod xem giúp em 3 sub này em chạy với dữ liệu sau kết quả lại sai:
Mã:
Option Explicit
Sub PhanBo()
    Dim arrTemp
    Dim c As Byte
    Dim lngSoCot As Long
    Dim shData As Worksheet
    Dim dblSoMax As Double, dblSoPhanBo As Double, dblThayDoi As Double, dblTotal As Boolean
    Set shData = Sheets("Sheet1")
    dblSoPhanBo = shData.Range("D5").Value
    arrTemp = shData.Range("B7:K7").Value
    shData.Range("B8:K8").ClearContents
    dblSoMax = 1000
    dblTotal = WorksheetFunction.Sum(arrTemp)
    dblThayDoi = dblTotal + dblSoPhanBo
    lngSoCot = UBound(arrTemp, 2)
    For c = 1 To lngSoCot
        arrTemp(1, c) = dblSoMax
        dblTotal = WorksheetFunction.Sum(arrTemp)
        If dblTotal > dblThayDoi Then
            arrTemp(1, c) = dblSoMax - (dblTotal - dblThayDoi)
            Exit For
        End If
    Next
    shData.Range("B8:K8").Value = arrTemp
End Sub
Sub PhanBo2()
    Dim arrTemp
    Dim c As Byte
    Dim lngSoCot As Long
    Dim shData As Worksheet
    Dim dblSoMax As Double, dblSoPhanBo As Double, dblThayDoi As Double, dblTotal As Boolean
    Set shData = Sheets("Sheet1")
    dblSoPhanBo = shData.Range("D5").Value
    arrTemp = shData.Range("B7:K7").Value
    shData.Range("B8:K8").ClearContents
    dblSoMax = 1000
    dblTotal = WorksheetFunction.Sum(arrTemp)
    dblThayDoi = dblTotal + dblSoPhanBo
    lngSoCot = UBound(arrTemp, 2)
    Do
        c = c + 1
       
        arrTemp(1, c) = dblSoMax 'Loi: Subscript out of range
        dblTotal = WorksheetFunction.Sum(arrTemp)
        If dblTotal > dblThayDoi Then
            arrTemp(1, c) = dblSoMax - (dblTotal - dblThayDoi)
            Exit Do
        End If
    Loop
    shData.Range("B8:K8").Value = arrTemp
End Sub

Sub PhanBo3()
    Dim arrTemp
    Dim c As Byte
    Dim lngSoCot As Long
    Dim shData As Worksheet
    Dim dblSoMax As Double, dblSoPhanBo As Double, dblThayDoi As Double, dblTotal As Boolean
    Set shData = Sheets("Sheet1")
    dblSoPhanBo = shData.Range("D5").Value
    arrTemp = shData.Range("B7:K7").Value
    shData.Range("B8:K8").ClearContents
    dblSoMax = 1000
    dblTotal = WorksheetFunction.Sum(arrTemp)
    dblThayDoi = dblTotal + dblSoPhanBo
    lngSoCot = UBound(arrTemp, 2)
    Do Until c = lngSoCot
        c = c + 1
        arrTemp(1, c) = dblSoMax
        dblTotal = WorksheetFunction.Sum(arrTemp)
        If dblTotal > dblThayDoi Then
            arrTemp(1, c) = dblSoMax - (dblTotal - dblThayDoi)
            Exit Do
        End If
    Loop
    shData.Range("B8:K8").Value = arrTemp
End Sub
View attachment 265009
Lạy hồn, tôi đã viết code với kiểu dữ liệu này hay sao?

1630223184644.png
 
Lạy hồn, tôi đã viết code với kiểu dữ liệu này hay sao?

View attachment 265012
Trời ạ ngàn lần sorry Mod, vì Mod khai báo thiếu em khai báo Double nhưng thế nào lại gõ nhầm thành Boolean ... :D
Nãy giờ tưởng máy tính bị nhiễm virut , tải lại bài 1 rồi code ket để kiểm tra các kiểu, đến khổ (@$%@

Chạy solver trong file đính kèm
Cái này chạy sao bác ơi? Code két có thêm gì đâu bác?
 
Trời ạ ngàn lần sorry Mod, vì Mod khai báo thiếu em khai báo Double nhưng thế nào lại gõ nhầm thành Boolean ... :D
Nãy giờ tưởng máy tính bị nhiễm virut , tải lại bài 1 rồi code ket để kiểm tra các kiểu, đến khổ (@$%@


Cái này chạy sao bác ơi? Code két có thêm gì đâu bác?
Solver là Addin có sẵn của excel, trong menu Data
 
Web KT
Back
Top Bottom