Chưa rõ ràng.
Cảm ơn bác đã xem bài và cho ý kiến,
Bạn thử dùng thủ tục này đúng không nhé.
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 SubCode 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.
mình test nó cũng bị như vậy, không biết bị gì?
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.
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).
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.
Bạn nhìn code này xem nó có cần Exit không nhé!
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.
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 SubTrườ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!
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
LoopNhờ Mod xem giúp em 3 sub này em chạy với dữ liệu sau kết quả lại sai:
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
Chạy solver trong file đính kèm
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 ...
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 DataTrờ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 ...
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?
OK , ngon rồi Mod nhé, vậy là dùng Do Until với cách này không phải dùng thêm Exit.
À có lẽ tôi khai báo thiếu, nhưng bạn phải hiểu đó là dữ liệu là dạng số, chứ sao lại dạng True/False? Vả lại khi tôi đặt biến, nhìn biến có tiền tố từ "dbl" thì nên hiểu nó có kiểu dữ liệu là Double rồi chứ nhỉ? Bạn nên để ý những ký tự đầu của biến tôi đặt nhé.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 ...
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ổ
Em không thấy có AddIn nào trong file bác gửi bài 17, bác gửi em đoạn code chạy của Addin đó với.
Bạn làm theo các bước sau:
Vâng thì cũng nói em khai báo Double nhưng thế nào lại gõ nhầm thành Boolean mà.,lỗi tại em Mod nhé.
Ô cái này hay đấy,nhưng sao lại thế nhỉ, bác giải thích cho em hiểu chút về cái này với.. sao chỉ cần chọn cái addin là có luôn thiết lập vậy?
Cho đoạn code này vào file cần tính, chạy sau khi mở file, vào menu Data sẽ thấy solver
Option Explicit
Sub Macro1()
AddIns("Solver Add-in").Installed = True
End SubBậy bạ à nha, nó chỉ thoát khi c = số cột thôi, nếu vẫn chưa thỏa điều kiện.
Tôi không nghĩ là tác giả chỉ chạy đúng một hàng, có thể là một bảng dữ liệu, không biết cái này nó có thực hiện được tất cả không nhỉ?
À thấy rồi em ko để ý code tưởng Mod nói vsi dụ em gửi đơn giản nên ko cần,túm lại là vẫn phải dùng exit, Ok Thanks Mod.
đấy đấy, đúng rồi đấy,cảm ơn sếp đã hiểu tâm tư của em.
Chạy nhiều dòng vẫn có thể được nhưng bị giới hạn số ô tính toán <= 200.
Vậy có giải quyết được yêu cầu của bài 1 không thế bạn
Được mà bác , em đã phản hồi ở bài 25 rồi đó, nếu bị giới hạn số ô tính toán 200 thì không được rồi , cảm ơn bác đã cho em biết thông tin.
Bạn cứ đưa dữ liệu tầm vài chục dòng lên thử xem bạn CHAOQUAY giải quyết như thế nào, để xem cơ chế nó hoạt động với nhiều dòng thế nào.
Ok, vậy em gửi dữ liệu nhiều làm phiền 2 bác xem giúp em, sorry em cập nhật thêm số liệu cần phân bổ.
Giới hạn trên của từng dòng được tính thế nào, tức là tương đương giá trị 1000 trong file bài 1 đó bạn
Theo như thông tin này của bác, em nghĩ là với dữ liệu em gửi trong file kèm trên sẽ khó xử lý vì nằm 2 bảng khác nhau và nhiều dữ liệu, nên em muốn code để xử lý có lẽ sẽ thuận tiện hơn.
Em có gửi giới hạn max (chính là sheet tiêu chuẩn đó ạ) cột check em có vlookup đến nó , bác ơi.
Đấy là "Số phân bổ" chứ bạn
à em nhầm, để em sửa lại thực ra nó là max đó ạ.
Thôi bác cứ để giúp em ví dụ max hết 1000 đi ạ em thấy hơi khó xử lý vì nhiều mã bác ạ, form là như vậy sau em sẽ cập nhật cho cho từng mã lại để check.
1000 thì không được vì có những dòng có giá trị > 1000. Vậy lấy tạm max từng dòng làm giới hạn trên, rồi tính sau nhé
OK bác cứ lấy cho em một ví dụ logic là được,cảm ơn bác.
Em thấy số bên bảng dữ liệu đang max=1500 vậy em sửa lại tiêu chuẩn trong khoảng 1600~1800 bác lấy file này giúp em nhé, mong muốn của em dùng code cho tiện không dùng công cụ có sẵn, các bác xem giúp em.
Ý của bạn số max dựa vào bảng này của sheet Tiêu Chuẩn?
Đúng rồi sếp, insert thêm cũng được sẽ có nhiều cột phụ, dữ liệu chạy nhiều dòng sợ nặng không sếp, cột check và cột sum là em insert thêm để kiểm tra thôi về cơ bản chỉ có bảng dò tiêu chuẩn và bảng dữ liệu như vậy sếp ạ.
Code của nó như thế này nhé:
Sub PhanBo_HTN()
Dim c As Byte
Dim arrTemp, arrData
Dim shData As Worksheet
Dim blnCheck As Boolean
Dim e As Long, r As Long, lngCol As Long, lngRow As Long
Dim dblSoMax As Double, dblSoPhanBo As Double, dblThayDoi As Double, dblTemp As Double
Set shData = Sheets("DU_LIEU")
shData.AutoFilterMode = False
e = shData.Range("B" & Rows.Count).End(xlUp).Row + 1
arrTemp = shData.Range("D3:F" & e).Value
arrData = shData.Range("G3:W" & e).Value
lngRow = UBound(arrData, 1)
lngCol = UBound(arrData, 2)
For r = 1 To lngRow Step 2
dblTemp = 0
blnCheck = False
dblSoMax = arrTemp(r, 1)
dblSoPhanBo = arrTemp(r, 3)
For c = 1 To lngCol
If Not blnCheck Then
dblTemp = dblTemp + (dblSoMax - arrData(r, c))
If dblTemp > dblSoPhanBo Then
blnCheck = True
arrData(r + 1, c) = dblSoPhanBo - (dblTemp - dblSoMax)
Else
arrData(r + 1, c) = dblSoMax
End If
Else
arrData(r + 1, c) = arrData(r, c)
End If
Next
Next
shData.Range("G3:W" & e).Value = arrData
shData.Range("A2:W2").AutoFilter
End SubCode dưới đây phân bổ theo số liệu cột E & F.
Option Explicit
Sub abc()
Dim Nguon, Spb
Dim TsDv
Dim Tong0, Tong1
Dim rws, cls
Dim i, j, k
With Sheet3
rws = .Range("C" & Rows.Count).End(xlUp).Row
Nguon = .Range("G3", "W" & rws)
TsDv = .Range("E3", "F" & rws)
rws = UBound(Nguon)
cls = UBound(Nguon, 2)
For i = 1 To rws - 1 Step 2
Tong0 = TsDv(i, 1)
Spb = TsDv(i, 2)
Tong1 = Tong0 + Spb
For j = 1 To cls
Nguon(i + 1, j) = WorksheetFunction.Round((Nguon(i, j) / Tong0) * Tong1, 0)
Next j
Next i
.Range("G3").Resize(UBound(Nguon), UBound(Nguon, 2)) = Nguon
End With
End SubChênh lệch này là đương nhiên thôi bạn, đây là do làm tròn của hàm ROUND() mà ra, cái này có thể điều chỉnh được.
Đương nhiên là có thể chỉnh được, nhưng trong bài #43 mình nghĩ không cần phải dùng hàm round và nó tuyệt đối đúng trong trường hợp của file mẫu. Thấy nó có vẻ hơi rườm rà tí, nhưng nó chỉ tính vài cột trong tất cả các cột thôi, còn lại là nó bê xuống không tính toán gì thêm nên nó sẽ ít tốn thời gian hơn.
Theo quan điểm cá nhân thì tỷ lệ giữa số liệu đặt & số liệu mua có lẽ là tương đối giống nhau cho các N của từng mã, code bài 44 viết theo quan điểm này.
À em đã hiểu, như vậy đây là phương pháp dàn đều cho tất cả các ngày, như vậy nó lẻ là đúng rồi, một ý tưởng cũng khá hay, cũng có lúc em sẽ cần đến phương án dàn kiểu này.
Dàn đều tôi cũng đã tính tới trường hợp này, nhưng yêu cầu của tác giả là phân bổ đúng số lượng cho trước cho những ô đầu tiên đến ô cuối cùng. Song, nếu dàn đều đi chăng nữa thì cũng lưu ý đến 2 điều kiện, một là mỗi ô không được vượt quá số max, hai là tổng số phân bổ không được cao hơn hoặc thấp hơn số lượng phân bổ.
Chính xác, hay sếp thêm giúp em một option này nữa nhỉ.
Bạn hay quá ha, được voi đòi 2 bà Tưng! Để tôi suy nghĩ rồi làm luôn cho bạn, lỡ phóng lao rồi phải theo lao luôn!
Cảm ơn sếp, em ngồi đây chờ tin của sếp. Bởi đây là bài toán trong thực tế em sẽ gặp phải, nếu sếp đã lỡ phóng lao rồi sếp làm luôn giúp em trong code lấy thông tin từ bảng dò tiêu chuẩn theo mã luôn mà khỏi dùng cột phụ vlookup sếp à.
Dò mệt lắm, để tôi dùng phương thức Find xem có nhanh không. Cho tôi hỏi, sau khi tính số phân bổ, nếu giả sử tổng số phân bổ có số dư ra thì trừ vào ô cuối trở về trước còn số thiếu thì cộng vào ô đầu đến ô cuối hay sao?
Nếu số phân bổ sau khi đã dàn đều mà vẫn còn dư sếp để vào ngày cuối giúp em, số ngày cuối có thể vượt max(chấp nhận điều này để xác định tổng ban đầu + phân bổ), bởi các ngày sau chỉ là dụ tính (dự báo)., nên nếu phân bổ còn dư sếp dồn hết ngày vào cuối ạ.
Tôi còn 3 thắc mắc nữa là,
Công nhận sếp nhìn xa thật,em chưa lường hết được các vấn đề này nhưng cũng sẽ đến lúc va phải, em giải thích theo từng mục câu hỏi của sếp nhưa sau:
Nếu để số lẻ thì khi định dạng kiểu "0" hay "#,##0" (nhìn giống như số nguyên) sẽ có hiện tượng khi in ra giấy tổng số thì bằng số phân bổ, nhưng cộng thủ công từng ô sẽ bị chênh lệch với số tổng ráng chịu đó.
Em hiểu chỗ này vậy sếp đừng format là được , cứ để nguyên bản lẻ.. khi cần dùng số em có thể balance rồi làm tròn cũng được sếp ạ, đoạn này gần bờ nên sếp cứ để em tự bơi.
Chạy thử file đính kèm.
Option Explicit
Sub abc_()
Dim Nguon
Dim canTren, ct
Dim Tong0, Tong1
Dim Spb, Sodu
Dim Kq
Dim rws, cls
Dim Dic As Object
Dim i, j, k
With Sheet3
rws = .Range("C" & Rows.Count).End(xlUp).Row
Nguon = .Range("A3:W" & rws)
rws = UBound(Nguon)
cls = UBound(Nguon, 2)
End With
canTren = Sheet2.Range("B3", Sheet2.Range("C3").End(xlDown))
ReDim Kq(1 To rws, 1 To cls - 6)
Set Dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(canTren)
Dic(canTren(i, 1)) = canTren(i, 2)
Next i
For i = 1 To rws - 1 Step 2
ct = Dic(Nguon(i, 2))
Tong0 = Nguon(i, 5)
Tong1 = Tong0 + Nguon(i, 6)
Sodu = 0
For j = 7 To cls
Kq(i, j - 6) = Nguon(i, j)
Spb = Nguon(i, j) * Tong1 \ Tong0
If Spb > ct Then
Kq(i + 1, j - 6) = ct
Else
Kq(i + 1, j - 6) = Spb
End If
Sodu = Sodu + Kq(i + 1, j - 6)
Next j
Sodu = Tong1 - Sodu
k = 0
Do While Sodu > 0
j = k Mod UBound(Kq, 2) + 1
k = k + 1
If Kq(i + 1, j) + 1 < ct Then
Kq(i + 1, j) = Kq(i + 1, j) + 1
Sodu = Sodu - 1
End If
Loop
Next i
Sheet3.Range("G3").Resize(UBound(Kq), UBound(Kq, 2)) = Kq
Set Dic = Nothing
End SubBạn phân bổ dàn đều theo thủ tục dưới đây! Đảm bảo chuẩn kèo!
Option Explicit
Sub PhanBo_DanDeu_HTN()
Dim rngTieuChuan As Range
Dim c As Byte, Cols As Byte
Dim arrPhanBo, arrDuLieu, arrCode
Dim shDuLieu As Worksheet, shTieuChuan As Worksheet
Dim e As Long, r As Long, lngCol As Long, lngRow As Long
Dim dblSoMax As Double, dblSoPhanBo As Double, dblThayDoi As Double, dblTemp As Double, dblRemain As Double, dblTotal As Double
Set shDuLieu = Sheets("DU_LIEU")
Set shTieuChuan = Sheets("TIEU_CHUAN")
shDuLieu.AutoFilterMode = False
shTieuChuan.AutoFilterMode = False
e = shTieuChuan.Range("B" & Rows.Count).End(xlUp).Row
Set rngTieuChuan = shTieuChuan.Range("B3:B" & e)
e = shDuLieu.Range("B" & Rows.Count).End(xlUp).Row + 1
arrPhanBo = shDuLieu.Range("F3:F" & e).Value
arrDuLieu = shDuLieu.Range("G3:W" & e).Value
arrCode = shDuLieu.Range("B3:B" & e).Value
lngRow = UBound(arrDuLieu, 1)
lngCol = UBound(arrDuLieu, 2)
For r = 1 To lngRow Step 2
dblSoPhanBo = arrPhanBo(r, 1)
dblRemain = dblSoPhanBo
dblSoMax = rngTieuChuan.Find(arrCode(r, 1), , xlValues, xlWhole).Offset(, 1).Value
dblTemp = Round(dblSoPhanBo / lngCol)
dblTotal = dblTemp
For c = 1 To lngCol
dblThayDoi = dblTemp + arrDuLieu(r, c)
If dblThayDoi > dblSoMax Then
arrDuLieu(r + 1, c) = dblSoMax
dblRemain = dblRemain - (dblSoMax - arrDuLieu(r, c))
Else
arrDuLieu(r + 1, c) = dblThayDoi
dblRemain = dblRemain - dblTemp
End If
Cols = lngCol - c
Select Case Cols
Case 1 To 6
dblTemp = Round(dblRemain / Cols)
dblTotal = dblTotal + dblTemp
Case 7
dblTemp = dblSoPhanBo - dblRemain
End Select
Next
Next
shDuLieu.Range("G3:W" & e).Value = arrDuLieu
shDuLieu.Range("A2:W2").AutoFilter
End SubSếp ơi, chuẩn 90% , còn 10% số dư chưa phân bổ hết phải cộng hết vào cuối nữa sếp:
Cảm ơn bác tương tự trường hợp trên,nếu em thử con số phân bổ cho tất cả các số nếu còn số dư thì quay tít bác nhỉ, có cho nó cộng hết vào số cuối rồi thoát vòng lặp được không bác.
Ah, tôi quên vụ cột nó có 17 mà tôi lại cho nó là 7 bạn thử sửa lại cái này nha. Thử chạy lại có đúng không!
Sub PhanBo_DanDeu_HTN()
Dim rngTieuChuan As Range
Dim c As Byte, Cols As Byte
Dim arrPhanBo, arrDuLieu, arrCode
Dim shDuLieu As Worksheet, shTieuChuan As Worksheet
Dim e As Long, r As Long, lngCol As Long, lngRow As Long
Dim dblSoMax As Double, dblSoPhanBo As Double, dblThayDoi As Double, dblTemp As Double, dblRemain As Double, dblTotal As Double
Set shDuLieu = Sheets("DU_LIEU")
Set shTieuChuan = Sheets("TIEU_CHUAN")
shDuLieu.AutoFilterMode = False
shTieuChuan.AutoFilterMode = False
e = shTieuChuan.Range("B" & Rows.Count).End(xlUp).Row
Set rngTieuChuan = shTieuChuan.Range("B3:B" & e)
e = shDuLieu.Range("B" & Rows.Count).End(xlUp).Row + 1
arrPhanBo = shDuLieu.Range("F3:F" & e).Value
arrDuLieu = shDuLieu.Range("G3:W" & e).Value
arrCode = shDuLieu.Range("B3:B" & e).Value
lngRow = UBound(arrDuLieu, 1)
lngCol = UBound(arrDuLieu, 2)
For r = 1 To lngRow Step 2
dblSoPhanBo = arrPhanBo(r, 1)
dblRemain = dblSoPhanBo
dblSoMax = rngTieuChuan.Find(arrCode(r, 1), , xlValues, xlWhole).Offset(, 1).Value
dblTemp = Round(dblSoPhanBo / lngCol)
dblTotal = dblTemp
For c = 1 To lngCol
dblThayDoi = dblTemp + arrDuLieu(r, c)
If dblThayDoi > dblSoMax Then
arrDuLieu(r + 1, c) = dblSoMax
dblRemain = dblRemain - (dblSoMax - arrDuLieu(r, c))
Else
arrDuLieu(r + 1, c) = dblThayDoi
dblRemain = dblRemain - dblTemp
End If
Cols = lngCol - c
Select Case Cols
Case 1 To lngCol - 1
dblTemp = Round(dblRemain / Cols)
dblTotal = dblTotal + dblTemp
Case lngCol
dblTemp = dblSoPhanBo - dblRemain
End Select
Next
Next
shDuLieu.Range("G3:W" & e).Value = arrDuLieu
shDuLieu.Range("A2:W2").AutoFilter
End Sub Select Case Cols
Case 1 To lngCol - 1
dblTemp = Round(dblRemain / Cols)
dblTotal = dblTotal + dblTemp
Case lngCol
dblTemp = dblSoPhanBo - dblRemain
End SelectBạn đưa file thử quay tít lên cho cụ thể nhé
Công thức này của bác không thấy bắt theo giới hạn max nhỉ? với lại bài này em muốn dùng code bác à, cảm ơn bác.
Sêp ơi, code trên W6 vẫn ra = 1710 nếu F5= 1000000
Sorry bác em gửi file, bác check giúp em.
Em gửi sếp file test , sếp xem giúp em nhé
Bạn thay thủ tục cũ bằng thủ tục dưới đây! Phải test như thế mới ra kết quả đúng. Bạn test tiếp đi.Sêp ơi, code trên W6 vẫn ra = 1710 nếu F5= 1000000
Option Explicit
Sub PhanBo_DanDeu_HTN()
Dim rngTieuChuan As Range
Dim c As Byte, Cols As Byte
Dim arrPhanBo, arrDuLieu, arrCode
Dim shDuLieu As Worksheet, shTieuChuan As Worksheet
Dim e As Long, r As Long, lngCol As Long, lngRow As Long
Dim dblSoMax As Double, dblSoPhanBo As Double, dblThayDoi As Double, dblTemp As Double, dblRemain As Double, dblTotal As Double
Set shDuLieu = Sheets("DU_LIEU")
Set shTieuChuan = Sheets("TIEU_CHUAN")
shDuLieu.AutoFilterMode = False
shTieuChuan.AutoFilterMode = False
e = shTieuChuan.Range("B" & Rows.Count).End(xlUp).Row
Set rngTieuChuan = shTieuChuan.Range("B3:B" & e)
e = shDuLieu.Range("B" & Rows.Count).End(xlUp).Row + 1
arrPhanBo = shDuLieu.Range("F3:F" & e).Value
arrDuLieu = shDuLieu.Range("G3:W" & e).Value
arrCode = shDuLieu.Range("B3:B" & e).Value
lngRow = UBound(arrDuLieu, 1)
lngCol = UBound(arrDuLieu, 2)
For r = 1 To lngRow Step 2
dblSoPhanBo = arrPhanBo(r, 1)
dblRemain = dblSoPhanBo
dblSoMax = rngTieuChuan.Find(arrCode(r, 1), , xlValues, xlWhole).Offset(, 1).Value
dblTemp = Round(dblSoPhanBo / lngCol)
dblTotal = dblTemp
For c = 1 To lngCol
dblThayDoi = dblTemp + arrDuLieu(r, c)
If dblThayDoi > dblSoMax Then
If c = lngCol Then
arrDuLieu(r + 1, c) = dblTemp + arrDuLieu(r, c)
Else
arrDuLieu(r + 1, c) = dblSoMax
dblRemain = dblRemain - (dblSoMax - arrDuLieu(r, c))
End If
Else
arrDuLieu(r + 1, c) = dblThayDoi
dblRemain = dblRemain - dblTemp
End If
Cols = lngCol - c
Select Case Cols
Case 1 To lngCol - 2
dblTemp = Round(dblRemain / Cols)
dblTotal = dblTotal + dblTemp
Case lngCol - 1
dblTemp = dblSoPhanBo - dblRemain
End Select
Next
Next
shDuLieu.Range("G3:W" & e).Value = arrDuLieu
shDuLieu.Range("A2:W2").AutoFilter
End SubOk rồi, chắc là ngon rồi sếp ạ ,cảm ơn sếp nhiều lắm, với Sub PhanBo_UuTien_HTN làm phiền sếp có thể làm tiếp cho em nếu còn số dư nó cũng để hết vào cuối như này được không sếp?
If dblThayDoi > dblSoMax Then
If c = lngCol Then
arrDuLieu(r + 1, c) = dblTemp + arrDuLieu(r, c)
Else If dblThayDoi > dblSoMax Then
If c = lngCol Then
arrDuLieu(r + 1, c) = dblThayDoi
ElseThời buổi này dịch vụ phải chọn gói sếp ạ. Ủa mà sếp cũng xem "bà Tân V-lốc" ạ kakaka.
Cái Ưu tiên thì cập nhật không cần VLOOKUP và phân bổ vào cái cuối nghèo út ăn giàu út chịu phải không?
OK , đồng ý sếp! Hi vọng sớm qua dịch để em gặp sếp làm trận tưng bừng
Không tính lỗ à anh ơi.
Phân bổ cái file này xong là đi tù cả mớ, làm tới đây thôi.Công thức này của bác không thấy bắt theo giới hạn max nhỉ? với lại bài này em muốn dùng code bác à, cảm ơn bác.
Sêp ơi, code trên W6 vẫn ra = 1710 nếu F5= 1000000
Sorry bác em gửi file, bác check giúp em.
Em gửi sếp file test , sếp xem giúp em nhé
Đang chờ bạn làm cái Solver mà chưa thấy gì hết đã thôi rồi hả?Phân bổ cái file này xong là đi tù cả mớ, làm tới đây thôi.
Solver thì được thôi nhưng với số liệu của bài 67 thì mất lửa rồi bác
Thì bạn chạy thử với dữ liệu chừng 50 dòng thôi. Được chứ nhỉ?
Tất nhiên là được. Bạn chạy solver trong file đính kèm, 2 dòng gọi là nhiều có lẽ cũng tạm được, 50 dòng cũng tương tự.
Ừ thì tưng bừng!OK , đồng ý sếp! Hi vọng sớm qua dịch để em gặp sếp làm trận tưng bừng
Sub PhanBo_UuTien_HTN()
Dim rngTieuChuan As Range
Dim c As Byte, Cols As Byte
Dim arrPhanBo, arrDuLieu, arrCode
Dim shDuLieu As Worksheet, shTieuChuan As Worksheet
Dim e As Long, r As Long, lngCol As Long, lngRow As Long
Dim dblSoMax As Double, dblRemain As Double, dblThayDoi As Double
Set shDuLieu = Sheets("DU_LIEU")
Set shTieuChuan = Sheets("TIEU_CHUAN")
shDuLieu.AutoFilterMode = False
shTieuChuan.AutoFilterMode = False
e = shTieuChuan.Range("B" & Rows.Count).End(xlUp).Row
Set rngTieuChuan = shTieuChuan.Range("B3:B" & e)
e = shDuLieu.Range("B" & Rows.Count).End(xlUp).Row + 1
arrPhanBo = shDuLieu.Range("F3:F" & e).Value
arrDuLieu = shDuLieu.Range("G3:W" & e).Value
arrCode = shDuLieu.Range("B3:B" & e).Value
lngRow = UBound(arrDuLieu, 1)
lngCol = UBound(arrDuLieu, 2)
For r = 1 To lngRow Step 2
dblRemain = arrPhanBo(r, 1)
dblSoMax = rngTieuChuan.Find(arrCode(r, 1), , xlValues, xlWhole).Offset(, 1).Value
For c = 1 To lngCol
If dblRemain > 0 Then
If c = lngCol Then
arrDuLieu(r + 1, c) = dblRemain + arrDuLieu(r, c)
Else
dblThayDoi = dblRemain + arrDuLieu(r, c)
If dblThayDoi > dblSoMax Then
arrDuLieu(r + 1, c) = dblSoMax
dblRemain = dblRemain - (dblSoMax - arrDuLieu(r, c))
Else
arrDuLieu(r + 1, c) = dblThayDoi
dblRemain = 0
End If
End If
Else
arrDuLieu(r + 1, c) = arrDuLieu(r, c)
End If
Next
Next
shDuLieu.Range("G3:W" & e).Value = arrDuLieu
shDuLieu.Range("A2:W2").AutoFilter
End SubĐã quá sếp ơi, code chạy lê tê quá, cảm ơn sếp nhiều
Bà Tưng, bà Tân bạn hốt hết rồi, còn bà nào nữa mà không đã!Đã quá sếp ơi, code chạy lê tê quá, cảm ơn sếp nhiều
Thôi sếp đến đây đã lắm rồi, em hỏi thôi mà cũng mệt,sếp khỏe thật đấy theo lao đến cùng vẫn chưa mệt, nể sếp thật.
![""":::":\](/diendan/styles/smilies/cbkg013.gif "sdrts \"\"\":::\":\")
Cái đó bạn tự xây dựng và giải quyết, khi nào có nhu cầu hay vướng mắc gì gửi lên đây, các thành viên ở GPE này sẽ giúp cho bạn.Thôi sếp đến đây đã lắm rồi, em hỏi thôi mà cũng mệt,sếp khỏe thật đấy theo lao đến cùng vẫn chưa mệt, nể sếp thật.
Bài toán khiến em cảm tưởng như lên kế hoạch sản xuất ấy với 2 kiểu chạy backwards and forwards giới hạn max giống năng suất, phân bổ là số lượng cần sản xuất thêm, có lẽ thêm mấy tiêu chí (không phân bổ vào một ngày nào đó giống như ngày nghỉ .v.v.. ) nữa thành ứng dụng lên kế hoạch sản xuất không chừng
OK, cảm ơn sếp, chờ một ngày đẹp trời.. sếp ngứa rảnh dỗi qua đây gõ vai từ thì lúc đó em sẽ hỏi sếp tiếp
Sếp @Hoàng Trọng Nghĩa ơi, xem giúp em có thể không bổ vào ngày nghỉ được không sếp ...OK, cảm ơn sếp, chờ một ngày đẹp trời.. sếp ngứa rảnh dỗi qua đây gõ vai từ thì lúc đó em sẽ hỏi sếp tiếp
Mặc dầu đã xong , nhưng cho phép em để cái hình ở đây để mai mốt sếp còn quay lại:
View attachment 265095
Rồi xong, hết 2 bà Tưng, rồi bà Tân Vê-lốc, giờ chắc bạn hốt luôn bà Phương Hằng quá! Để tôi suy nghĩ đã.Sếp @Hoàng Trọng Nghĩa ơi, xem giúp em có thể không bổ vào ngày nghỉ được không sếp ...
Em cảm ơn sếp nhiều, thực sự khi áp dụng em thấy nó là vấn đề thực tế và đang xảy ra , mong sếp xem suy xét rồi có hướng xử lý nhanh chóng giúp em.
Bạn đưa cái file lên đi, tôi không mò được đâu.OK, cảm ơn sếp, chờ một ngày đẹp trời.. sếp ngứa rảnh dỗi qua đây gõ vai từ thì lúc đó em sẽ hỏi sếp tiếp
Mặc dầu đã xong , nhưng cho phép em để cái hình ở đây để mai mốt sếp còn quay lại:
View attachment 265095
Có ngay đêy ạ, em gửi sếp để sếp xem giúp em.
Cứ theo quy định sếp đã làm cho em, giờ thêm điều kiện không cho nó xuất hiện ở ngày nghỉ là được sếp ạ.. như vậy số còn dư sẽ theo quy tắc cũ cộng dồn hết vào ngày cuối sếp ạ.
Ý là cái số có của nó có đem xuống hàng dưới hay không?
Sếp ơi số liệu vẫn điền hết xuống dòng dưới sếp ạ, dòng trên là dòng ban đầu nên vẫn giữ nguyên (không thay đổi) sếp ạ.
Có nghĩa là bê nguyên xuống và không cộng thêm số lượng phân bổ?
Ảnh này của Sếp dòng trên có thì kệ dòng trên đi sếp (không thay đổi), dòng dưới tương ứng ngày nghỉ này sẽ không có sếp ạ, nó sẽ phân bổ tiếp.
Không phải vậy sếp, vẫn cộng theo theo cách cũ, chỉ là ở dòng dưới không hiển thị (vì nó là ngày nghỉ) nó sẽ phân bổ sang các ngày không phải ngày nghỉ và phần dư sẽ dồn về cuối,nếu các ngày khác đều là max không phân bổ được nữa thì các dòng ngày nghỉ có số sẽ đưa hết về cuối sếp ạ.
Không hiểu tôi hỏi gì hay sao trời? Thí dụ phân bổ là 10, dòng trên là 69 thì dòng dưới nếu không phải lễ thì 69+10=79 còn nếu có lễ thì bằng bao nhiêu? 0 hay 69 hay là 79?
Sorry sếp, em hơi chậm hiểu (câu hỏi này của sếp rất cần thiết)
Sếp ơi hay sếp cứ cộng tất số lượng ngày nghỉ vào số phân bổ rồi thực hiện phân bổ cho đỡ rắc rối sếp ạ.Ví dụ sếp cộng 69 của ngày nghỉ vào 10 số phân bổ như vậy tổng phân bổ sẽ bằng 79
Trường hợp ngày cuối cùng mà nhầm luôn ngày lễ thì sao?
Chuẩn thật, sếp suy nghĩ rất thấu đáo, em không nghĩ ra.
