Phân bổ số lượng hàng bán vào số lượng hàng tồn kho theo hạn sử dụng. (1 người xem)

[linhcute2000]

Chào Anh/Chị trên GPE

Em có bài toán phân bổ số lượng hàng bán dựa vào số lượng hàng tồn kho theo hạn sử dụng (có điều kiện kèm theo)
Từ sheet BanHang, dựa vào số lượng bán tổng cộng của từng mã hàng theo từng shop
Dựa vào số lương tồn kho chi tiết theo Shop,Mã hàng, HSD ở sheet TonKho
Điều kiện phân bổ: chỉ lấy các mặt hàng có hạn sử dụng từ tháng 05.2018 trở về sau để phân bổ hàng bán vào
Lấy từ hạn sử dụng 05.2018 trở đi và phân bổ dần số lượng bán cho đến hết.
(Lấy sheet TonKho làm trọng tâm -> phân bổ số lượng bán hàng -> ra sheet KetQua)
(Sheet KetQua tương đương số dòng như sheet TonKho, chỉ thêm cột phân bổ & Còn tồn)
Nhờ Anh/Chị trên GPE viết cho đoạn code VBA để thực hiện vấn đề trên

Anh/Chị Xem File em làm mẫu ở sheet KetQua ạ!
Xin trân trọng cảm ơn!

 

[linhcute2000]

Xin Anh/ Chị giúp đỡ em ạ!

 

[quocgiacan]

Chào Anh/Chị trên GPE

Em có bài toán phân bổ số lượng hàng bán dựa vào số lượng hàng tồn kho theo hạn sử dụng (có điều kiện kèm theo)
Từ sheet BanHang, dựa vào số lượng bán tổng cộng của từng mã hàng theo từng shop
Dựa vào số lương tồn kho chi tiết theo Shop,Mã hàng, HSD ở sheet TonKho
Điều kiện phân bổ: chỉ lấy các mặt hàng có hạn sử dụng từ tháng 05.2018 trở về sau để phân bổ hàng bán vào
Lấy từ hạn sử dụng 05.2018 trở đi và phân bổ dần số lượng bán cho đến hết.
(Lấy sheet TonKho làm trọng tâm -> phân bổ số lượng bán hàng -> ra sheet KetQua)
(Sheet KetQua tương đương số dòng như sheet TonKho, chỉ thêm cột phân bổ & Còn tồn)
Nhờ Anh/Chị trên GPE viết cho đoạn code VBA để thực hiện vấn đề trên

Anh/Chị Xem File em làm mẫu ở sheet KetQua ạ!
Xin trân trọng cảm ơn!

Bạn tham khảo cách dùng công thức:
Sheet 'KetQua': Nhớ điều chỉnh dữ liệu cột D theo dạng: 01/mm/yyyy, bạn tham khảo file đính kèm.

F3=(D3>=DATE(2018,5,1))*(MIN(SUMIFS(BanHang!$D$3:$D$20,BanHang!$B$3:$B$20,$B3,BanHang!$C$3:$C$20,$C3)-SUMIFS($F$2:$F2,$B$2:$B2,$B3,$C$2:$C2,$C3),E3))

Enter fill xuống.

Chúc bạn ngày vui.

 

[linhcute2000]

Bạn tham khảo cách dùng công thức:
Sheet 'KetQua': Nhớ điều chỉnh dữ liệu cột D theo dạng: 01/mm/yyyy, bạn tham khảo file đính kèm.

F3=(D3>=DATE(2018,5,1))*(MIN(SUMIFS(BanHang!$D$3:$D$20,BanHang!$B$3:$B$20,$B3,BanHang!$C$3:$C$20,$C3)-SUMIFS($F$2:$F2,$B$2:$B2,$B3,$C$2:$C2,$C3),E3))

Enter fill xuống.

Chúc bạn ngày vui.

Cảm ơn anh ạ!
Em cũng tính tới hướng là dùng công thức nhưng dữ liệu của em tới tận 300.000 dòng & đang có xu hướng sẽ tăng lên rất nhiều trong thời gian tới nên công thức không kham nổi ạ!
Cũng rất mong Anh/ Chị nào đó hỗ trợ em bằng đoạn VBA

Xin trận trọng cảm ơn!

 

[quocgiacan]

dữ liệu của em tới tận 300.000 dòng & đang có xu hướng sẽ tăng lên rất nhiều trong thời gian tới

Cái này thì thiệt tình là công thức "bó tay" và cũng "bó toàn thân"!

Chúc bạn ngày vui.

 

[HieuCD]

Chào Anh/Chị trên GPE

Em có bài toán phân bổ số lượng hàng bán dựa vào số lượng hàng tồn kho theo hạn sử dụng (có điều kiện kèm theo)
Từ sheet BanHang, dựa vào số lượng bán tổng cộng của từng mã hàng theo từng shop
Dựa vào số lương tồn kho chi tiết theo Shop,Mã hàng, HSD ở sheet TonKho
Điều kiện phân bổ: chỉ lấy các mặt hàng có hạn sử dụng từ tháng 05.2018 trở về sau để phân bổ hàng bán vào
Lấy từ hạn sử dụng 05.2018 trở đi và phân bổ dần số lượng bán cho đến hết.
(Lấy sheet TonKho làm trọng tâm -> phân bổ số lượng bán hàng -> ra sheet KetQua)
(Sheet KetQua tương đương số dòng như sheet TonKho, chỉ thêm cột phân bổ & Còn tồn)
Nhờ Anh/Chị trên GPE viết cho đoạn code VBA để thực hiện vấn đề trên

Anh/Chị Xem File em làm mẫu ở sheet KetQua ạ!
Xin trân trọng cảm ơn!

Chạy code

Sub PhanBo()
  Dim dArr As Variant, sArr As Variant, Arr As Variant, HanDung As Date
  With Sheets("BanHang")
    dArr = .Range("B3:D" & .Range("B" & Rows.Count).End(xlUp).Row).Value
  End With
  With Sheets("TonKho")
    Arr = .Range("A3:G" & .Range("B" & Rows.Count).End(xlUp).Row).Value
  End With
  HanDung = DateSerial(2018, 5, 1)
  With CreateObject("scripting.dictionary")
    For i = 1 To UBound(Arr)
      Arr(i, 7) = Arr(i, 5)
      Arr(i, 6) = Empty
      If DateSerial(CLng(Right(Arr(i, 4), 4)), CLng(Left(Arr(i, 4), 2)), 1) >= HanDung Then
        Key = Arr(i, 2) & "#" & Arr(i, 3)
        If Not .exists(Key) Then
          .Add Key, 1
          .Add Key & "#" & 1, i
        Else
          .Item(Key) = .Item(Key) + 1
          .Add Key & "#" & .Item(Key), i
        End If
      End If
    Next i
    For i = 1 To UBound(dArr)
      Key = dArr(i, 1) & "#" & dArr(i, 2)
      If .exists(Key) Then
        n = .Item(Key)
        For j = 1 To n
          keyj = Key & "#" & j
          If .exists(keyj) Then
            ik = .Item(keyj)
            If dArr(i, 3) < Arr(ik, 7) Then
              Arr(ik, 6) = Arr(ik, 6) + dArr(i, 3)
              Arr(ik, 7) = Arr(ik, 7) - dArr(i, 3)
              Exit For
            Else
              Arr(ik, 6) = Arr(ik, 6) + Arr(ik, 7)
              dArr(i, 3) = dArr(i, 3) - Arr(ik, 7)
              Arr(ik, 7) = Empty
              .Remove (keyj)
              If dArr(i, 3) = 0 Then Exit For
            End If
          End If
        Next j
      End If
    Next i
  End With
  With Sheets("KetQua")
    .Range("D3").Resize(UBound(Arr)).NumberFormat = "@"
    .Range("A3").Resize(UBound(Arr), 7) = Arr
    .Range("A3").Resize(UBound(Arr), 7).Borders.LineStyle = 1
  End With
End Sub

 

[linhcute2000]

Chạy code

Trân trọng cảm ơn anh! Code chạy ngon lành ạ!
Cơ mà code này em đọc mà chẳng hiểu gì cả, anh có thể chú thích từng dòng được không ạ?

 

[HieuCD]

Trân trọng cảm ơn anh! Code chạy ngon lành ạ!
Cơ mà code này em đọc mà chẳng hiểu gì cả, anh có thể chú thích từng dòng được không ạ?

Logic của code theo phương pháp nhập trước xuất trước khá phức tạp, hơi khó giải thích cho bạn
Hy vọng bạn hiểu được qui trình xử lý của mình

Sub PhanBo()
  Dim dArr As Variant, sArr As Variant, Arr As Variant, HanDung As Date
  With Sheets("BanHang") 'Gán du liêu Ban hàng
    dArr = .Range("B3:D" & .Range("B" & Rows.Count).End(xlUp).Row).Value
  End With
  With Sheets("TonKho") 'Gán du liêu Tòn kho
    Arr = .Range("A3:G" & .Range("B" & Rows.Count).End(xlUp).Row).Value
  End With
  HanDung = DateSerial(2018, 5, 1) ' Han dùng toi thiêu phan bo,là ngay 1 thang 5 nam 2018(thang 5 nam 2018)
  With CreateObject("scripting.dictionary")
    For i = 1 To UBound(Arr) 'xét tòn kho
      Arr(i, 7) = Arr(i, 5) ' cho còn tòn = ton dau
      Arr(i, 6) = Empty ' xóa du lieu cot phan bo, de phòng cot F có du lieu khong mong muon
      'neu han dùng thoa yeu cau han dùng toi thieu thì nap du lieu vào Dic
      If DateSerial(CLng(Right(Arr(i, 4), 4)), CLng(Left(Arr(i, 4), 2)), 1) >= HanDung Then
        Key = Arr(i, 2) & "#" & Arr(i, 3) 'Tieu chuan nhan dang key cua Dic là Ma Shop và Ma hang
        If Not .exists(Key) Then 'Neu gap key (Ma shop & Ma hang) moi
          .Add Key, 1 'Nap key vào Dic voi thu tu key la 1
          .Add Key & "#" & 1, i ' nap key và thu tu vao Dic, voi Item là thu tu dòng cua Arr
        Else ' Neu key da có (key cu)
          .Item(Key) = .Item(Key) + 1 'thu tu cua Key tang len 1
          'thu tu cua key càng lon thì han su dung se lau hon, do du lieu duoc xep thu tu theo thoi gian
          .Add Key & "#" & .Item(Key), i ' nap key và thu tu vao Dic, voi Item là thu tu dòng cua Arr
        End If
      End If
    Next i
   
    'xu lý xuat kho theo phuong phap nhap truoc xuat truoc, theo dieu kien han su dung
    For i = 1 To UBound(dArr)
      Key = dArr(i, 1) & "#" & dArr(i, 2)
      'neu key có trong Dic, nghia là có trong sheet Tonkho và han su dung >= 5.2018
      'néu khong thoa dieu kien thì khong làm gì. Neu du lieu nhap sai co the báo cáo se thieu du lieu nay
      If .exists(Key) Then
        n = .Item(Key)  'so dòng du lieu cua Key thoa dieu kien trong TonKho
        For j = 1 To n 'chay tu thu tu 1 den thu tu cuoi
          keyj = Key & "#" & j
          If .exists(keyj) Then ' neu Key thu j chua phan bo het so luong ton
            ik = .Item(keyj) 'thu tu dòng cua mang Arr
            If dArr(i, 3) < Arr(ik, 7) Then 'neu so luong can phan bo < so luong ton còn lai o dòng ik thì phan bo het cho dòng ik
              Arr(ik, 6) = Arr(ik, 6) + dArr(i, 3)
              Arr(ik, 7) = Arr(ik, 7) - dArr(i, 3)
              Exit For 'Lan ban hang nay da phan bo het, xet lan ban hang ke tiep
            Else 'Neu so luong can phan bo >= so luong ton còn lai
              Arr(ik, 6) = Arr(ik, 6) + Arr(ik, 7) 'phan bo so luong còn ton
              dArr(i, 3) = dArr(i, 3) - Arr(ik, 7) 'giam so can phan bo
              Arr(ik, 7) = Empty ' so luong con ton =0
              .Remove (keyj) ' remove dong du lieu da phan bo het, de khong ban bo cho lan ke tiep
              If dArr(i, 3) = 0 Then Exit For ' xet lan ban hang ke tiep
            End If
          End If
        Next j
      End If
    Next i
  End With
  With Sheets("KetQua")
    .Range("D3").Resize(UBound(Arr)).NumberFormat = "@"
    .Range("A3").Resize(UBound(Arr), 7) = Arr
    .Range("A3").Resize(UBound(Arr), 7).Borders.LineStyle = 1
  End With
End Sub

Bna5 mở code, bấm phím chức năng F8 chạy từng dòng lệnh, để hình dung cách vận hành của các câu lệnh

 

[Ba Tê]

Cảm ơn anh ạ!
Em cũng tính tới hướng là dùng công thức nhưng dữ liệu của em tới tận 300.000 dòng & đang có xu hướng sẽ tăng lên rất nhiều trong thời gian tới nên công thức không kham nổi ạ!
Cũng rất mong Anh/ Chị nào đó hỗ trợ em bằng đoạn VBA

Xin trận trọng cảm ơn!

Trên 300.000 dòng thì làm chung vào sheet TonKho luôn cho gọn.

 

[HieuCD]

Trên 300.000 dòng thì làm chung vào sheet TonKho luôn cho gọn.

Code rất hay, chỉ lưu ý thêm một Shop có thể bán 1 mã hàng nhiều lần

 

[Ba Tê]

Code rất hay, chỉ lưu ý thêm một Shop có thể bán 1 mã hàng nhiều lần

Tôi đã viết thế này

For I = 1 To R1
            Tem = tArr(I, 1) & "#" & tArr(I, 2)
            .Item(Tem) = .Item(Tem) + tArr(I, 3)
        Next I

Nhưng dữ liệu tác giả chưa tổng quát nên ráng chịu.