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

Hoàng Trọng Nghĩa · 11/9/21

3ii đã viết:
Chuẩn thật, sếp suy nghĩ rất thấu đáo, em không nghĩ ra.
Nếu vậy thì sẽ đổ hết vào ngày làm việc gần nhất trước đó sếp ạ.. trường hợp cả tháng nghỉ mà chỉ có một ngày làm việc thì dồn hết vào ngày đó nếu không có ngày làm việc nào thì thôi exit sub luôn cho khoẻ sếp ạ.

Chua thiệt nhưng vẫn làm thử cho bạn, kiểm tra xem có OK chưa!?

PHP:

Sub PhanBo_UuTien_HTN_New()

    Dim ObjDict As Object
    Dim blnCheckHoliday As Boolean
    Dim c As Byte, Cols As Byte, bteWkCol As Byte
    Dim shDuLieu As Worksheet, shTieuChuan As Worksheet
    Dim arrPhanBo, arrTieuChuan, arrWorking, arrDuLieu(), arrCode()
    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")
    Set ObjDict = CreateObject("Scripting.Dictionary")
   
    shDuLieu.AutoFilterMode = False
    shTieuChuan.AutoFilterMode = False
   
    e = shTieuChuan.Range("B" & Rows.Count).End(xlUp).Row
    arrTieuChuan = shTieuChuan.Range("B3:C" & e).Value
    For r = 1 To UBound(arrTieuChuan)
        ObjDict(arrTieuChuan(r, 1)) = arrTieuChuan(r, 2)
    Next
   
    arrWorking = shDuLieu.Range("G1:W1").Value
   
    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 = ObjDict(arrCode(r, 1))
       
        For c = 1 To lngCol
            blnCheckHoliday = False
            arrDuLieu(r + 1, c) = ""
            If LCase(arrWorking(1, c)) = "holiday" Then
                blnCheckHoliday = True
            Else
                bteWkCol = c
            End If
            If dblRemain > 0 Then
                If c < lngCol Then
                    If Not blnCheckHoliday Then
                        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
                    Else
                        dblRemain = dblRemain + arrDuLieu(r, c)
                    End If
                Else
                    If Not blnCheckHoliday Then
                        arrDuLieu(r + 1, c) = dblRemain + arrDuLieu(r, c)
                    Else
                        arrDuLieu(r + 1, bteWkCol) = dblRemain + arrDuLieu(r, c) + arrDuLieu(r + 1, bteWkCol)
                    End If
                End If
            Else
                If Not blnCheckHoliday Then
                    arrDuLieu(r + 1, c) = arrDuLieu(r, c)
                Else
                    dblRemain = dblRemain + arrDuLieu(r, c)
                End If
            End If
        Next c
    Next r
   
    Set ObjDict = Nothing
    shDuLieu.Range("G3:W" & e).Value = arrDuLieu
    shDuLieu.Range("A2:W2").AutoFilter
End Sub

Ngày mai trời lại sáng · 11/9/21

Hoàng Trọng Nghĩa đã viết:

Chua thiệt nhưng vẫn làm thử cho bạn, kiểm tra xem có OK chưa!?

PHP:

Sub PhanBo_UuTien_HTN_New()

    Dim ObjDict As Object
    Dim blnCheckHoliday As Boolean
    Dim c As Byte, Cols As Byte, bteWkCol As Byte
    Dim shDuLieu As Worksheet, shTieuChuan As Worksheet
    Dim arrPhanBo, arrTieuChuan, arrWorking, arrDuLieu(), arrCode()
    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")
    Set ObjDict = CreateObject("Scripting.Dictionary")
  
    shDuLieu.AutoFilterMode = False
    shTieuChuan.AutoFilterMode = False
  
    e = shTieuChuan.Range("B" & Rows.Count).End(xlUp).Row
    arrTieuChuan = shTieuChuan.Range("B3:C" & e).Value
    For r = 1 To UBound(arrTieuChuan)
        ObjDict(arrTieuChuan(r, 1)) = arrTieuChuan(r, 2)
    Next
  
    arrWorking = shDuLieu.Range("G1:W1").Value
  
    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 = ObjDict(arrCode(r, 1))
      
        For c = 1 To lngCol
            blnCheckHoliday = False
            arrDuLieu(r + 1, c) = ""
            If LCase(arrWorking(1, c)) = "holiday" Then
                blnCheckHoliday = True
            Else
                bteWkCol = c
            End If
            If dblRemain > 0 Then
                If c < lngCol Then
                    If Not blnCheckHoliday Then
                        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
                    Else
                        dblRemain = dblRemain + arrDuLieu(r, c)
                    End If
                Else
                    If Not blnCheckHoliday Then
                        arrDuLieu(r + 1, c) = dblRemain + arrDuLieu(r, c)
                    Else
                        arrDuLieu(r + 1, bteWkCol) = dblRemain + arrDuLieu(r, c) + arrDuLieu(r + 1, bteWkCol)
                    End If
                End If
            Else
                If Not blnCheckHoliday Then
                    arrDuLieu(r + 1, c) = arrDuLieu(r, c)
                Else
                    dblRemain = dblRemain + arrDuLieu(r, c)
                End If
            End If
        Next c
    Next r
  
    Set ObjDict = Nothing
    shDuLieu.Range("G3:W" & e).Value = arrDuLieu
    shDuLieu.Range("A2:W2").AutoFilter
End Sub

Sorry sếp, hôm nay nhà em đi tiêm vacxin thấy người hơi mệt nên off sớm.
Để mai em test rồi sẽ báo cáo với sếp kết quả tình hình, lần này điều khiện phức tạp và nhiều hơn nhưng hi vọng code chạy đúng ý.
Em cảm ơn sếp rất nhiều.

Hoàng Trọng Nghĩa · 12/9/21

3ii đã viết:
Sorry sếp, hôm nay nhà em đi tiêm vacxin thấy người hơi mệt nên off sớm.
Để mai em test rồi sẽ báo cáo với sếp kết quả tình hình, lần này điều khiện phức tạp và nhiều hơn nhưng hi vọng code chạy đúng ý.
Em cảm ơn sếp rất nhiều.

Nếu tất cả là ngày nghỉ thì sao? Chẳng hạn nghỉ dịch bệnh vừa qua?

Ngày mai trời lại sáng · 12/9/21

Hoàng Trọng Nghĩa đã viết:
Nếu tất cả là ngày nghỉ thì sao? Chẳng hạn nghỉ dịch bệnh vừa qua?

Ặc, sếp vẫn online á, em thấy áy láy quá, ở bài 102 em có nêu trường hợp này nếu sảy ra sếp ạ:

nếu không có ngày làm việc nào thì thôi exit sub luôn cho khoẻ sếp ạ.

Như vậy dòng 2 không có gì luôn sếp ạ, và kết quả check chắc chắn bằng False rồi vì nó không phân bổ được đi đâu cả.

Hoàng Trọng Nghĩa · 12/9/21

3ii đã viết:
Ặc, sếp vẫn online á, em thấy áy láy quá, ở bài 102 em có nêu trường hợp này nếu sảy ra sếp ạ:

Như vậy dòng 2 không có gì luôn sếp ạ, và kết quả check chắc chắn bằng False rồi vì nó không phân bổ được đi đâu cả.

Vậy nghỉ dịch bệnh cũng là holiday hay tên gọi gì khác không?

Ngày mai trời lại sáng · 12/9/21

Hoàng Trọng Nghĩa đã viết:
Vậy nghỉ dịch bệnh cũng là holiday hay tên gọi gì khác không?

Sếp ơi em mất ngủ mới biết là sếp vẫn còn ngồi đó !$@!!

,sếp giữ sức khỏe giùm em.
Thường thì gọi chung là ngày nghỉ thôi sếp hoặc sếp cho em thêm một dạng nữa là nghỉ "Covid" sếp nhé (đề phòng phát sinh thôi), trường hợp này cũng giống "holiday" và chung quy lại là vẫn là ngày nghỉ nên các cột này sẽ không có số sếp ạ, cảm ơn sếp.

Hoàng Trọng Nghĩa · 12/9/21

3ii đã viết:
Sếp ơi em mất ngủ mới biết là sếp vẫn còn ngồi đó ,sếp giữ sức khỏe giùm em.
Thường thì gọi chung là ngày nghỉ thôi sếp hoặc sếp cho em thêm một dạng nữa là nghỉ "Covid" sếp nhé (đề phòng phát sinh thôi), trường hợp này cũng giống "holiday" và chung quy lại là vẫn là ngày nghỉ nên các cột này sẽ không có số sếp ạ, cảm ơn sếp.

OK, nếu không có ngày nào làm việc thì nó sẽ thông báo rồi Exit Sub.

PHP:

Sub PhanBo_UuTien_HTN_New_2()

    Dim ObjDict As Object
    Dim blnCheckHoliday As Boolean
    Dim c As Byte, Cols As Byte, bteWkCol As Byte
    Dim shDuLieu As Worksheet, shTieuChuan As Worksheet
    Dim arrPhanBo, arrTieuChuan, arrWorking, arrDuLieu(), arrCode()
    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")
    
    arrWorking = shDuLieu.Range("G1:W1").Value
    lngCol = UBound(arrWorking, 2)
    
    For c = 1 To lngCol
        If LCase(arrWorking(1, c)) = "working" Then
            Exit For
        End If
    Next
    If c > lngCol Then
        MsgBox "Tat ca thoi gian deu khong lam viec!", vbInformation + vbOKOnly, "Thông Báo"
        Exit Sub
    End If
    
    Set shTieuChuan = Sheets("TIEU_CHUAN")
    Set ObjDict = CreateObject("Scripting.Dictionary")
    
    shDuLieu.AutoFilterMode = False
    shTieuChuan.AutoFilterMode = False
    
    e = shTieuChuan.Range("B" & Rows.Count).End(xlUp).Row
    arrTieuChuan = shTieuChuan.Range("B3:C" & e).Value
    For r = 1 To UBound(arrTieuChuan)
        ObjDict(arrTieuChuan(r, 1)) = arrTieuChuan(r, 2)
    Next
    
    
    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)
    
    For r = 1 To lngRow Step 2
        
        dblRemain = arrPhanBo(r, 1)
        dblSoMax = ObjDict(arrCode(r, 1))
        
        For c = 1 To lngCol
            blnCheckHoliday = False
            arrDuLieu(r + 1, c) = ""
            If LCase(arrWorking(1, c)) = "holiday" Then
                blnCheckHoliday = True
            Else
                bteWkCol = c
            End If
            If dblRemain > 0 Then
                If c < lngCol Then
                    If Not blnCheckHoliday Then
                        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
                    Else
                        dblRemain = dblRemain + arrDuLieu(r, c)
                    End If
                Else
                    If Not blnCheckHoliday Then
                        arrDuLieu(r + 1, c) = dblRemain + arrDuLieu(r, c)
                    Else
                        arrDuLieu(r + 1, bteWkCol) = dblRemain + arrDuLieu(r, c) + arrDuLieu(r + 1, bteWkCol)
                    End If
                End If
            Else
                If Not blnCheckHoliday Then
                    arrDuLieu(r + 1, c) = arrDuLieu(r, c)
                Else
                    dblRemain = dblRemain + arrDuLieu(r, c)
                End If
            End If
        Next c
    Next r
    Set ObjDict = Nothing
    shDuLieu.Range("G3:W" & e).Value = arrDuLieu
    shDuLieu.Range("A2:W2").AutoFilter
End Sub

Ngày mai trời lại sáng · 12/9/21

Hoàng Trọng Nghĩa đã viết:

OK, nếu không có ngày nào làm việc thì nó sẽ thông báo rồi Exit Sub.

PHP:

Sub PhanBo_UuTien_HTN_New_2()

    Dim ObjDict As Object
    Dim blnCheckHoliday As Boolean
    Dim c As Byte, Cols As Byte, bteWkCol As Byte
    Dim shDuLieu As Worksheet, shTieuChuan As Worksheet
    Dim arrPhanBo, arrTieuChuan, arrWorking, arrDuLieu(), arrCode()
    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")
   
    arrWorking = shDuLieu.Range("G1:W1").Value
    lngCol = UBound(arrWorking, 2)
   
    For c = 1 To lngCol
        If LCase(arrWorking(1, c)) = "working" Then
            Exit For
        End If
    Next
    If c > lngCol Then
        MsgBox "Tat ca thoi gian deu khong lam viec!", vbInformation + vbOKOnly, "Thông Báo"
        Exit Sub
    End If
   
    Set shTieuChuan = Sheets("TIEU_CHUAN")
    Set ObjDict = CreateObject("Scripting.Dictionary")
   
    shDuLieu.AutoFilterMode = False
    shTieuChuan.AutoFilterMode = False
   
    e = shTieuChuan.Range("B" & Rows.Count).End(xlUp).Row
    arrTieuChuan = shTieuChuan.Range("B3:C" & e).Value
    For r = 1 To UBound(arrTieuChuan)
        ObjDict(arrTieuChuan(r, 1)) = arrTieuChuan(r, 2)
    Next
   
   
    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)
   
    For r = 1 To lngRow Step 2
       
        dblRemain = arrPhanBo(r, 1)
        dblSoMax = ObjDict(arrCode(r, 1))
       
        For c = 1 To lngCol
            blnCheckHoliday = False
            arrDuLieu(r + 1, c) = ""
            If LCase(arrWorking(1, c)) = "holiday" Then
                blnCheckHoliday = True
            Else
                bteWkCol = c
            End If
            If dblRemain > 0 Then
                If c < lngCol Then
                    If Not blnCheckHoliday Then
                        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
                    Else
                        dblRemain = dblRemain + arrDuLieu(r, c)
                    End If
                Else
                    If Not blnCheckHoliday Then
                        arrDuLieu(r + 1, c) = dblRemain + arrDuLieu(r, c)
                    Else
                        arrDuLieu(r + 1, bteWkCol) = dblRemain + arrDuLieu(r, c) + arrDuLieu(r + 1, bteWkCol)
                    End If
                End If
            Else
                If Not blnCheckHoliday Then
                    arrDuLieu(r + 1, c) = arrDuLieu(r, c)
                Else
                    dblRemain = dblRemain + arrDuLieu(r, c)
                End If
            End If
        Next c
    Next r
    Set ObjDict = Nothing
    shDuLieu.Range("G3:W" & e).Value = arrDuLieu
    shDuLieu.Range("A2:W2").AutoFilter
End Sub

Chào sếp, xin đa tạ sếp đã suốt đêm thao thức vì em.
Em đã test code trên, kết quả đúng những gì em đã mô tả đến sếp.

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

Người dùng đang xem chủ đề này

Hoàng Trọng Nghĩa

Chuyên gia GPE

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

Thành viên thường trực

Hoàng Trọng Nghĩa

Chuyên gia GPE

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

Thành viên thường trực

Hoàng Trọng Nghĩa

Chuyên gia GPE

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

Thành viên thường trực

Hoàng Trọng Nghĩa

Chuyên gia GPE

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

Thành viên thường trực

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Thời gian đếm ngược.