Cái quan trọng là số tiền mệnh giá nhỏ nhất đủ chia. Còn có thể quy ra a->b->c->d. Thêm cột, để ý tiền mệnh giá 5000*(2n+1).anhtuan1066 đã viết:Vậy đâu có dc... Như thế là bạn ưu tiên tờ mệnh giá 500,000 à... Hơi tham... he.. he...
Cái quan trọng là số tiền mệnh giá nhỏ nhất đủ chia. Còn có thể quy ra a->b->c->d. Thêm cột, để ý tiền mệnh giá 5000*(2n+1).anhtuan1066 đã viết:Vậy đâu có dc... Như thế là bạn ưu tiên tờ mệnh giá 500,000 à... Hơi tham... he.. he...
Bài toán này đã trên 1 năm, với nhiều phương án, bây giờ mới tìm được cách giải. Có thể nó chưa hoàn chỉnh về thuật toán, về tốc độ nhưng cơ bản đã giải quyết được yêu cầu của đề bài. Xin gởi tặng các anh chị kế toán, thủ quỹ để chia sẽ khó khăn mỗi đợt phát lương.Giã sử cô thử ký đi lãnh tiền về chia cho công nhân, cô ta lãnh dc Y đồng gồm có 5 loại mệnh giá:
-A tờ loại a đồng (mệnh giá lớn nhất)
-B tờ loại b đồng (mệnh giá lớn thứ 2)
-C tờ loại c đồng (mệnh giá lớn thứ 3)
-D tờ loại c đồng (mệnh giá lớn thứ 4)
-E tờ loại e đồng (mệnh giá lớn thứ 5)
Cô ta chia số tiền này cho 100 người: n001, n002, ... n100
Từng người lần lượt dc lãnh X1, X2... X100 đồng
Vậy phải chia số tiền Y đồng này cho 100 người như thế nào là hợp lý? Mỗi người dc nhận bao nhiêu tờ trong mỗi loại mệnh giá trên? Giã định rằng tiền lãnh của mỗi người luôn là bội số của loại tiền mệnh giá nhỏ nhất (tức ko bị lẽ)
Các bạn có ai từng gặp chuyện tương tự thế này chưa? Là chia tiền đó... Xin hỏi thuật toán của bài toán này là gì? Tôi nghĩ hoài vẫn ko ra!
Mong dc góp ý!
ANH TUẤN
Sub PhatLuong()
Dim nLoaiTien As Long, rDanhSach As Long, cLoaiTien1 As Long, cLoaiTien2 As Long, cTmp As Long
Dim nSoTo As Long, nSoTo1 As Long, rSoTo As Long, nHeSo As Double
Dim cDanhSach As Long, rDanhSach1 As Long, rDanhSach2 As Long
Dim sToPhat As Long, nToPhat As Long, nToDu As Long, nToThieu As Long
Dim rr As Long, cc As Long
On Error GoTo baoloi
ActiveCell.Select
Cells.Find(What:="Lo" & ChrW(7841) & "i ti" & ChrW(7873) & "n", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Activate
cDanhSach = ActiveCell.Column: rDanhSach = ActiveCell.Row
cLoaiTien1 = cDanhSach + 1
cLoaiTien2 = Cells(rDanhSach, cLoaiTien1).End(xlToRight).Column
cTmp = cLoaiTien2 + 1
rSoTo = rDanhSach + 1
rDanhSach1 = rDanhSach + 5
rDanhSach2 = Cells(rDanhSach, cDanhSach).End(xlDown).Row
Range(Cells(rDanhSach + 2, cLoaiTien1), Cells(rDanhSach2, cLoaiTien2 + 1)).ClearContents
Range(Cells(rDanhSach, cTmp), Cells(rDanhSach + 1, cTmp)).ClearContents
Cells(rDanhSach1 - 1, cTmp) = "Phát thi" & ChrW(7871) & "u"
Range(Cells(rDanhSach, cDanhSach), Cells(rDanhSach2 + 1, cLoaiTien2 + 2)).Borders.LineStyle = 0
Range(Cells(rDanhSach, cDanhSach), Cells(rDanhSach2, cTmp)).Borders.LineStyle = 1
Range(Cells(rDanhSach1, cDanhSach), Cells(rDanhSach2, cDanhSach)).Copy Cells(rDanhSach1, cTmp)
For cc = cLoaiTien1 To cLoaiTien2
nLoaiTien = Cells(rDanhSach, cc)
nSoTo = Cells(rSoTo, cc)
nSoTo1 = 0
For rr = rDanhSach1 To rDanhSach2
Cells(rr, cc) = Cells(rr, cTmp) \ nLoaiTien
nSoTo1 = nSoTo1 + Cells(rr, cc)
Next rr
If nSoTo1 = 0 Then nHeSo = 0 Else nHeSo = nSoTo / nSoTo1
sToPhat = 0
For rr = rDanhSach1 To rDanhSach2
If nSoTo1 > nSoTo Then
nToPhat = Round(nHeSo * Cells(rr, cc), 0)
If sToPhat + nToPhat > nSoTo Then nToPhat = nSoTo - sToPhat
Else
nToPhat = Cells(rr, cc)
End If
sToPhat = sToPhat + nToPhat
Cells(rr, cc) = nToPhat
Cells(rr, cTmp) = Cells(rr, cTmp) - nToPhat * nLoaiTien
Next rr
nToDu = nSoTo - sToPhat
If nToDu > 0 Then
For rr = rDanhSach1 To rDanhSach2
nToPhat = Cells(rr, cTmp) \ nLoaiTien
If nToPhat > 0 Then
If nToPhat >= nToDu Then
Cells(rr, cc) = Cells(rr, cc) + nToDu
Cells(rr, cTmp) = Cells(rr, cTmp) - nToDu * nLoaiTien
Exit For
Else
nToPhat = Cells(rr, cc)
End If
End If
Next rr
End If
Cells(rSoTo + 1, cc) = Application.WorksheetFunction.Sum(Range(Cells(rDanhSach1, cc), Cells(rDanhSach2, cc)))
Cells(rSoTo + 2, cc) = nSoTo - Cells(rSoTo + 1, cc)
Next cc
For rr = rDanhSach1 To rDanhSach2
If Cells(rr, cTmp) > 0 Then
nToThieu = Cells(rr, cTmp)
For cc = cLoaiTien1 To cLoaiTien2
nToPhat = nToThieu \ Cells(rDanhSach, cc)
If nToPhat > 0 Then
Cells(rSoTo + 3, cc) = Cells(rSoTo + 3, cc) + nToPhat
nToThieu = nToThieu - Cells(rDanhSach, cc) * nToPhat
End If
Next
End If
Next rr
Range(Cells(rDanhSach, cDanhSach), Cells(rDanhSach2, cTmp)).Columns.AutoFit
Exit Sub
baoloi:
MsgBox "Khong tim thay bang hoac bang khong dung mau quy dinh", vbOKOnly, "Thong bao"
End
End Sub
Sub SoToToiUu()
Dim nLoaiTien As Long, rDanhSach As Long, cLoaiTien1 As Long, cLoaiTien2 As Long, cTmp As Long
Dim rSoTo As Long, cDanhSach As Long, rDanhSach1 As Long, rDanhSach2 As Long
Dim nToPhat As Long, rr As Long, cc As Long
On Error GoTo baoloi
ActiveCell.Select
Cells.Find(What:="Lo" & ChrW(7841) & "i ti" & ChrW(7873) & "n", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Activate
cDanhSach = ActiveCell.Column: rDanhSach = ActiveCell.Row
cLoaiTien1 = cDanhSach + 1
cLoaiTien2 = Cells(rDanhSach, cLoaiTien1).End(xlToRight).Column
cTmp = cLoaiTien2 + 1
rSoTo = rDanhSach + 1
rDanhSach1 = rDanhSach + 5
rDanhSach2 = Cells(rDanhSach, cDanhSach).End(xlDown).Row
Range(Cells(rDanhSach + 1, cLoaiTien1), Cells(rDanhSach2, cLoaiTien2 + 1)).ClearContents
Cells(rDanhSach1 - 1, cTmp) = "Phát thi" & ChrW(7871) & "u"
Range(Cells(rDanhSach, cDanhSach), Cells(rDanhSach2 + 1, cLoaiTien2 + 2)).Borders.LineStyle = 0
Range(Cells(rDanhSach, cDanhSach), Cells(rDanhSach2, cTmp)).Borders.LineStyle = 1
Range(Cells(rDanhSach1, cDanhSach), Cells(rDanhSach2, cDanhSach)).Copy Cells(rDanhSach1, cTmp)
Cells(rDanhSach + 2, cLoaiTien1) = "T" & ChrW(7889) & "i " & ChrW(432) & "u"
For cc = cLoaiTien1 To cLoaiTien2
nLoaiTien = Cells(rDanhSach, cc)
For rr = rDanhSach1 To rDanhSach2
nToPhat = Cells(rr, cTmp) \ nLoaiTien
Cells(rr, cc) = nToPhat
Cells(rr, cTmp) = Cells(rr, cTmp) - nToPhat * nLoaiTien
Next rr
Cells(rSoTo, cc) = Application.WorksheetFunction.Sum(Range(Cells(rDanhSach1, cc), Cells(rDanhSach2, cc)))
Next cc
If Application.WorksheetFunction.Sum(Range(Cells(rDanhSach1, cTmp), Cells(rDanhSach2, cTmp))) > 0 Then
Cells(rDanhSach + 1, cTmp) = "Thi" & ChrW(7871) & "u lo" & ChrW(7841) & "i ti" & ChrW(7873) & "n"
Cells(rDanhSach + 2, cTmp) = "d" & ChrW(432) & ChrW(7899) & "i " & Cells(rDanhSach, cLoaiTien2) & ChrW(273)
End If
Range(Cells(rDanhSach, cDanhSach), Cells(rDanhSach2, cTmp)).Columns.AutoFit
Exit Sub
baoloi:
MsgBox "Khong tim thay bang hoac bang khong dung mau quy dinh", vbOKOnly, "Thong bao"
End
End Sub
Bài toán này đã có giải pháp bằng công thức ở một topic khác. Mời mọi người vào tham khảo.Bài toán này đã trên 1 năm, với nhiều phương án, bây giờ mới tìm được cách giải. Có thể nó chưa hoàn chỉnh về thuật toán, về tốc độ nhưng cơ bản đã giải quyết được yêu cầu của đề bài. Xin gởi tặng các anh chị kế toán, thủ quỹ để chia sẽ khó khăn mỗi đợt phát lương.
VBA Phat Luong.xls có 2 chức năng:
1. Số tờ phát tối ưu:
Tìm số tờ phát theo từng loại tiền tối ưu. Dữ liệu cần: Loại tiền, Tiền lương.
Chức năng này giúp bạn biết số tờ theo từng loại tiền. Thủ quỹ chỉ việc chuẩn bị đổi tiền và phát theo bảng kê.
2. Phát lương:
Tìm số tờ phát theo từng loại tiền theo số tờ có thực tế trong quỹ. Dữ liệu cần: Loại tiền, Số tiền có, Tiền lương.
Chức năng này phân tích số tờ phát ra theo từng loại, thừa, thiếu. Từ đó thủ quỹ biết được các loại tiền thiếu cần bổ sung thêm
Bảng dữ liệu (hình 1): Vị trí bảng có thể bố trí bất kỳ nhưng phải đáp ứng các yêu cầu sau để nhận dạng tự động vị trí của bảng:
- Ô đầu tiên để xác định bảng là ô có chữ “Loại tiền”. Trong sheet không có ô nào khác chứa nội dung như vậy)
- Cột cuối cùng của bảng là cột kế bên trái loại tiền cuối cùng (nhận dạng bằng vị trí ô trống đầu tiên bên phải dòng Loại tiền). Dòng cuối cùng của bảng là dòng cuối cùng của tiền (nhận dạng bằng vị trí ô trống đầu tiên phía dưới tiền lương) trong hình là 2 ô màu đỏ.
Không nên thay đổi cấu trúc của bảng. Theo yêu cầu riêng, bạn có thể thêm dữ liệu vào như STT, Họ tên, ngày tháng, …. vào bất kỳ ô nào (ngoại trừ khu vực bảng và 2 ô nhận dạng)
![]()
hình 1
Bài toán này đã trên 1 năm, với nhiều phương án, bây giờ mới tìm được cách giải. Có thể nó chưa hoàn chỉnh về thuật toán, về tốc độ nhưng cơ bản đã giải quyết được yêu cầu của đề bài. Xin gởi tặng các anh chị kế toán, thủ quỹ để chia sẽ khó khăn mỗi đợt phát lương.
VBA Phat Luong.xls có 2 chức năng:
Để đảm bảo cho người nhận nhận số tờ ít nhất, nguyên tắc chia số tờ như sau:
1. Chia tiền lớn trước, tiền nhỏ sau.
2. Cùng một loại tiền, số tờ nhận của từng người tỷ lệ với số tiền lương (tránh trường hợp 1 người nhận loại tiền lớn quá nhiều, người khác nhận tiền nhỏ quá nhiều)
1. Số tờ phát tối ưu:
Tìm số tờ phát theo từng loại tiền tối ưu. Dữ liệu cần: Loại tiền, Tiền lương.
Chức năng này giúp bạn biết số tờ theo từng loại tiền. Thủ quỹ chỉ việc chuẩn bị đổi tiền và phát theo bảng kê.
2. Phát lương:
Tìm số tờ phát theo từng loại tiền theo số tờ có thực tế trong quỹ. Dữ liệu cần: Loại tiền, Số tiền có, Tiền lương.
Chức năng này phân tích số tờ phát ra theo từng loại, thừa, thiếu. Từ đó thủ quỹ biết được các loại tiền thiếu cần bổ sung thêm
Bảng dữ liệu (hình 1): Vị trí bảng có thể bố trí bất kỳ nhưng phải đáp ứng các yêu cầu sau để nhận dạng tự động vị trí của bảng:
- Ô đầu tiên để xác định bảng là ô có chữ “Loại tiền”. Trong sheet không có ô nào khác chứa nội dung như vậy)
- Cột cuối cùng của bảng là cột kế bên trái loại tiền cuối cùng (nhận dạng bằng vị trí ô trống đầu tiên bên phải dòng Loại tiền). Dòng cuối cùng của bảng là dòng cuối cùng của tiền (nhận dạng bằng vị trí ô trống đầu tiên phía dưới tiền lương) trong hình là 2 ô màu đỏ.
Không nên thay đổi cấu trúc của bảng. Theo yêu cầu riêng, bạn có thể thêm dữ liệu vào như STT, Họ tên, ngày tháng, …. vào bất kỳ ô nào (ngoại trừ khu vực bảng và 2 ô nhận dạng)
![]()
hình 1
Bài này dùng công thức cũng được mà bạn. Hơi dài và cầu kỳ thôiFile hay quá ạ. Em muốn hỏi chút nếu giờ không phải là 7 người mà thêm nhiều người nữa thì phải sửa file ở đâu ạ?
Em cảm ơn nhiều.
Bài này dùng công thức cũng được mà bạn. Hơi dài và cầu kỳ thôi
Vâng nhưng nếu thêm số người tăng lên thì file kia phải sửa ở chỗ nào ạ? Thanks.
Chèn dòng vào bảng là được thôi ạ
Cùng 1 câu hỏi như bạn - nhờ cao nhân chỉ giúp