- Tham gia
- 17/8/08
- Bài viết
- 8,590
- Được thích
- 16,653
- Giới tính
- Nam
Ừ 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
PHP:
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
![""":::":\](/diendan/styles/smilies/cbkg013.gif "sdrts \"\"\":::\":\")
