Lấy thông tin theo ngày từ bé tới lớn và số lượng trừ dần đến hết

mshuyenvn · 12/9/22

Mình cần giúp đỡ và sẵn sàng trả phí ạ.
Hiện mình có file phải thường xuyên làm nhưng trước giờ phải làm thủ công và rất mất thời gian.
Mong được mọi người hỗ trợ.
Cảm ơn rất nhiều!

Hiện mình có file nhập NPL và cần điền thông tin xuất NPL tương ứng với tên NPL và ngày xuất từ nhỏ tới lớn. Và số lượng của mã xuất sẽ được trừ dần tới khi hết và chuyển qua mã xuất tiếp theo.
Em cũng k biết nên giải thích như thế nào cho đúng nhất. Nhờ mn xem file giúp em với ạ

HieuCD · 12/9/22

mshuyenvn đã viết:
Mình cần giúp đỡ và sẵn sàng trả phí ạ.
Hiện mình có file phải thường xuyên làm nhưng trước giờ phải làm thủ công và rất mất thời gian.
Mong được mọi người hỗ trợ.
Cảm ơn rất nhiều!

Hiện mình có file nhập NPL và cần điền thông tin xuất NPL tương ứng với tên NPL và ngày xuất từ nhỏ tới lớn. Và số lượng của mã xuất sẽ được trừ dần tới khi hết và chuyển qua mã xuất tiếp theo.
Em cũng k biết nên giải thích như thế nào cho đúng nhất. Nhờ mn xem file giúp em với ạ

Kiểm tra lại

Mã:

Option Explicit
Sub XYZ()
  Dim aXuat(), aPL(), res(), PL$, sl#, pr$
  Dim srXuat&, srPL&, i&, r&
 
  With Sheets("XUATNPL")
    i = .Range("A1000000").End(xlUp).Row
    If i < 3 Then MsgBox ("Khong co Xuat!"): Exit Sub
    aXuat = .Range("A3:E" & i).Value
  End With
  With Sheets("BAOCAO")
    aPL = .Range("B3:G" & .Range("B3").End(xlDown).Row).Value
  End With
  srXuat = UBound(aXuat): srPL = UBound(aPL)
  ReDim res(1 To srPL, 1 To 4)
  For i = 1 To srPL
    PL = aPL(i, 1)
    sl = aPL(i, 2)
    Do While sl > 0
      For r = 1 To srXuat
        If aXuat(r, 3) = PL Then
          If aXuat(r, 5) > 0 Then
            If res(i, 1) = Empty Then pr = Empty Else pr = Chr(10)
            res(i, 1) = res(i, 1) & pr & aXuat(r, 1)
            res(i, 2) = res(i, 2) & pr & Format(aXuat(r, 4), "dd/mm/yyyy")
            res(i, 4) = res(i, 4) & pr & aXuat(r, 2)
            If aXuat(r, 5) >= sl Then
              res(i, 3) = res(i, 3) + sl
              aXuat(r, 5) = aXuat(r, 5) - sl
              sl = 0
              Exit For
            Else
              res(i, 3) = res(i, 3) + aXuat(r, 5)
              sl = sl - aXuat(r, 5)
              aXuat(r, 5) = 0
            End If
          End If
        End If
      Next r
      If r = srXuat + 1 Then sl = 0
    Loop
  Next i
  Sheets("BAOCAO").Range("E3").Resize(srPL, 4).NumberFormat = "@"
  Sheets("BAOCAO").Range("D3").Resize(srPL, 4) = res
  Sheets("BAOCAO").Range("A3").Resize(srPL, 7).Borders.LineStyle = 1
End Sub

mshuyenvn · 13/9/22

Dạ. Đúng luôn rồi ấy ạ. Em cảm ơn anh nhiều lắm.

mshuyenvn · 20/9/22

HieuCD đã viết:

Kiểm tra lại

Mã:

Option Explicit
Sub XYZ()
  Dim aXuat(), aPL(), res(), PL$, sl#, pr$
  Dim srXuat&, srPL&, i&, r&
 
  With Sheets("XUATNPL")
    i = .Range("A1000000").End(xlUp).Row
    If i < 3 Then MsgBox ("Khong co Xuat!"): Exit Sub
    aXuat = .Range("A3:E" & i).Value
  End With
  With Sheets("BAOCAO")
    aPL = .Range("B3:G" & .Range("B3").End(xlDown).Row).Value
  End With
  srXuat = UBound(aXuat): srPL = UBound(aPL)
  ReDim res(1 To srPL, 1 To 4)
  For i = 1 To srPL
    PL = aPL(i, 1)
    sl = aPL(i, 2)
    Do While sl > 0
      For r = 1 To srXuat
        If aXuat(r, 3) = PL Then
          If aXuat(r, 5) > 0 Then
            If res(i, 1) = Empty Then pr = Empty Else pr = Chr(10)
            res(i, 1) = res(i, 1) & pr & aXuat(r, 1)
            res(i, 2) = res(i, 2) & pr & Format(aXuat(r, 4), "dd/mm/yyyy")
            res(i, 4) = res(i, 4) & pr & aXuat(r, 2)
            If aXuat(r, 5) >= sl Then
              res(i, 3) = res(i, 3) + sl
              aXuat(r, 5) = aXuat(r, 5) - sl
              sl = 0
              Exit For
            Else
              res(i, 3) = res(i, 3) + aXuat(r, 5)
              sl = sl - aXuat(r, 5)
              aXuat(r, 5) = 0
            End If
          End If
        End If
      Next r
      If r = srXuat + 1 Then sl = 0
    Loop
  Next i
  Sheets("BAOCAO").Range("E3").Resize(srPL, 4).NumberFormat = "@"
  Sheets("BAOCAO").Range("D3").Resize(srPL, 4) = res
  Sheets("BAOCAO").Range("A3").Resize(srPL, 7).Borders.LineStyle = 1
End Sub

Anh @HieuCD ơi, anh có thể viết thêm giúp em 1 đoạn để phần mã sản phẩm, mã xuất, ngày xuất k lấy dữ liệu trùng đc k ạ? Dữ liệu thực tế của em bị trùng nhiều quá, dòng thể hiện không hết được luôn

HieuCD · 24/9/22

mshuyenvn đã viết:
Anh @HieuCD ơi, anh có thể viết thêm giúp em 1 đoạn để phần mã sản phẩm, mã xuất, ngày xuất k lấy dữ liệu trùng đc k ạ? Dữ liệu thực tế của em bị trùng nhiều quá, dòng thể hiện không hết được luôn

Cụ thể như thế nào? gởi file với kết quả mong muốn
Lưu ý, theo nội quy diễn đàn không nên dùng từ viết tắt

mshuyenvn · 24/9/22

HieuCD đã viết:
Cụ thể như thế nào? gởi file với kết quả mong muốn
Lưu ý, theo nội quy diễn đàn không nên dùng từ viết tắt

Em gửi anh file em đang làm ạ.
Cụ thể thì sheet GPE là sheet em dựa theo công thức của anh.
Sheet MONGMUON là kết quả cuối cùng em muốn đc trả về ạ.

HieuCD · 26/9/22

mshuyenvn đã viết:
Em gửi anh file em đang làm ạ.
Cụ thể thì sheet GPE là sheet em dựa theo công thức của anh.
Sheet MONGMUON là kết quả cuối cùng em muốn đc trả về ạ.

Sheeet XUATNPL nhập lại công thức
C6 =DATEVALUE(RIGHT(D6,4)&MID(RIGHT(D6,8),1,4)&MID(RIGHT(D6,10),1,2))
copy xuống
Chạy code

Mã:

Option Explicit
Sub XYZ()
  Dim aXuat(), aPL(), res(), PL$, sl#, pr$, ngay$
  Dim srXuat&, srPL&, i&, r&, dic As Object
 
  With Sheets("XUATNPL")
    i = .Range("A1000000").End(xlUp).Row 'COT MA XUAT
    If i < 3 Then MsgBox ("Khong co Xuat!"): Exit Sub
    aXuat = .Range("A6:M" & i).Value 'TIM MANG DU LIEU
  End With
  With Sheets("GPE")
    aPL = .Range("C15:R" & .Range("C15").End(xlDown).Row).Value
  End With
  srXuat = UBound(aXuat): srPL = UBound(aPL)
  ReDim res(1 To srPL, 1 To 9)
  Set dic = CreateObject("Scripting.Dictionary")
  For i = 1 To srPL
    PL = aPL(i, 1) 'TEN NPL
    sl = aPL(i, 4) 'so luong
    If sl > 0 Then
      For r = 1 To srXuat
        If aXuat(r, 9) = PL Then 'TEN NPL THUOC SHEET XUATNPL
          If aXuat(r, 13) > 0 Then 'SO LUONG SHEET XUATNPL
            If res(i, 1) = Empty Then pr = Empty Else pr = Chr(10)
            If dic.exists(aXuat(r, 4)) = False Then
              dic.Add aXuat(r, 4), ""
              res(i, 1) = res(i, 1) & pr & aXuat(r, 4) 'MA XUAT
            End If
            ngay = Format(aXuat(r, 3), "dd/mm/yyyy") 'NGAY XUAT NPL
            If dic.exists(ngay) = False Then
              dic.Add ngay, ""
              res(i, 3) = res(i, 3) & pr & ngay
            End If
            If dic.exists(aXuat(r, 5)) = False Then
              dic.Add aXuat(r, 5), ""
              res(i, 7) = res(i, 7) & pr & aXuat(r, 5) 'MA SAN PHAM
            End If
            res(i, 9) = aXuat(r, 12)
            res(i, 5) = aXuat(r, 11)
            
            If aXuat(r, 13) >= sl Then
              res(i, 8) = res(i, 8) + sl 'SO LUONG
              aXuat(r, 13) = aXuat(r, 13) - sl
               Exit For
            Else
              res(i, 8) = res(i, 8) + aXuat(r, 13) 'SO LUONG
              sl = sl - aXuat(r, 13)
              aXuat(r, 13) = 0
            End If          
          End If          
        End If
      Next r
    End If
    dic.RemoveAll
  Next i
  For i = 1 To srPL
    If res(i, 9) <> Empty Then res(i, 4) = Round(res(i, 8) / res(i, 9), 0)
  Next i
  Sheets("GPE").Range("m15").Resize(srPL, 9).NumberFormat = "@"
  Sheets("GPE").Range("k15").Resize(srPL, 9) = res
  Sheets("GPE").Range("C15").Resize(srPL, 9).Borders.LineStyle = 1
 End Sub

Lấy thông tin theo ngày từ bé tới lớn và số lượng trừ dần đến hết

mshuyenvn

Thành viên mới

File đính kèm

HieuCD

Chuyên gia GPE

mshuyenvn

Thành viên mới

mshuyenvn

Thành viên mới

HieuCD

Chuyên gia GPE

mshuyenvn

Thành viên mới

File đính kèm

HieuCD

Chuyên gia GPE

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