Tính Tồn Hợp đồng Của Vật Tư theo LIFO (1 người xem)

  • Thread starter Thread starter DMQ
  • Ngày gửi Ngày gửi
Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
DMQ

DMQ

Thành viên dốt
Tham gia
21/3/12
Bài viết
741
Được thích
63
Giới tính
Nam
Chào các anh chị!!!!
Em có file Excel tính tồn theo Hợp Đồng (HD) của thép tấm,mong các anh chị giúp đỡ.
Trong file sheet Ton_LIFO em có mô tả,mong anh chị giúp.
Em Cám Ơn!!!
 

File đính kèm

Em xin bổ sung là em đang dùng Excel 2010.
 
DMQ đã viết:
Chào các anh chị!!!!
Em có file Excel tính tồn theo Hợp Đồng (HD) của thép tấm,mong các anh chị giúp đỡ.
Trong file sheet Ton_LIFO em có mô tả,mong anh chị giúp.
Em Cám Ơn!!!
Nhấp chuột vào đây để mở rộng...
Chào bạn,
Mình làm thử bằng VBA theo nguyên tắc LIFO theo từng Code Item và Hợp đồng.
Khi xuất, chương trình sẽ trừ từ lô nhập gần nhất trước; nếu không đủ sẽ tự động trừ tiếp lô trước đó.
Bạn tải file đính kèm chạy thử xem có đúng với yêu cầu thực tế không nhé.
 

File đính kèm

Cám ơn bạn Ngày mai trời lại sáng nha!!!!
Mình thử thấy OK rồi, sheet ChiTiet_LIFO là bảng phụ hả bạn,không làm gì trên sheet này phải không bạn. Cám ơn bạn nhiều.
Bài này dùng công thức chắc không được bạn nhỉ.
À, sao mấy số có dấu chấm đằng sau là sao bạn?
Bài đã được tự động gộp:

À bạn ơi,ở sheet Ton_LIFO mình copy tay từ sheet Nhap và Sheet Xuat qua rồi Sort tăng dần theo ngày đó, vậy code có thể làm luôn được không bạn Ngày mai trời lại sáng??
 
Lần chỉnh sửa cuối:
DMQ đã viết:
Cám ơn bạn Ngày mai trời lại sáng nha!!!!
Mình thử thấy OK rồi, sheet ChiTiet_LIFO là bảng phụ hả bạn,không làm gì trên sheet này phải không bạn. Cám ơn bạn nhiều.
Bài này dùng công thức chắc không được bạn nhỉ.
À, sao mấy số có dấu chấm đằng sau là sao bạn?
Bài đã được tự động gộp:

À bạn ơi,ở sheet Ton_LIFO mình copy tay từ sheet Nhap và Sheet Xuat qua rồi Sort tăng dần theo ngày đó, vậy code có thể làm luôn được không bạn Ngày mai trời lại sáng??
Nhấp chuột vào đây để mở rộng...
Bạn tải lại file bài 3 nhé: chỉ cần cập nhật 2 sheet Nhập và Xuất rồi bấm
nút "Cập nhật LIFO". Macro sẽ tự gộp dữ liệu, sắp xếp theo ngày và tính
tồn theo từng Hợp Đồng theo nguyên tắc LIFO — xuất trừ lô nhập gần nhất
trước, thiếu thì lùi lô trước; một lần xuất có thể ăn qua nhiều HĐ, xuất
vượt tồn sẽ báo [THIẾU TỒN].
--------------------
Nhân dịp lễ, chúc bạn và cả nhà GPE một kỳ nghỉ vui vẻ, bình an!
 
Cám ơn bạn nha!!! CHÚC BẠN NGHỈ LỄ VUI VẺ!!!!!
Bài đã được tự động gộp:

Tức là sheet "ChiTiet_LIFO" không đụng chạm gì hả bạn,hoặc Delete cũng không được phải không bạn Ngày mai trời lại sáng???
Cám ơn bạn nha !!!!
 
Lần chỉnh sửa cuối:
DMQ đã viết:
Cám ơn bạn nha!!! CHÚC BẠN NGHỈ LỄ VUI VẺ!!!!!
Bài đã được tự động gộp:

Tức là sheet "ChiTiet_LIFO" không đụng chạm gì hả bạn,hoặc Delete cũng không được phải không bạn Ngày mai trời lại sáng???
Cám ơn bạn nha !!!!
Nhấp chuột vào đây để mở rộng...
Đúng rồi bạn, ChiTiet_LIFO chỉ là bảng phụ để tra cứu, bạn không cần
làm gì trên đó.

Mỗi lần bấm nút "Cập nhật LIFO", macro sẽ xóa sạch sheet này rồi ghi
lại từ đầu. Vì vậy bạn đừng tự điền hay ghi chú thêm gì vào đó — lần
bấm nút sau nó sẽ bị xóa hết, không giữ lại được.

Sheet này chỉ để xem mỗi lần Xuất trừ vào HĐ nào và bao nhiêu; nếu xuất
vượt tồn thì có dòng [THIẾU TỒN] tô đỏ cho dễ thấy.

Còn xóa (Delete) sheet đó cũng không sao, lần sau macro tự tạo lại.
Không cần dùng thì bấm chuột phải vào tab sheet → Hide để ẩn đi.
 
Có phát sinh thêm vật tư hay HD cũng không sao hả bạn Ngày mai trời lại sáng ???
 
DMQ đã viết:
Có phát sinh thêm vật tư hay HD cũng không sao hả bạn Ngày mai trời lại sáng ???
Nhấp chuột vào đây để mở rộng...
Có lẽ bạn nên tự thử thêm mặt hàng, thêm nhập, thêm xuất, ... trước khi hỏi. Động tay động chân, động não 1 chút.
 
DMQ đã viết:
Có phát sinh thêm vật tư hay HD cũng không sao hả bạn Ngày mai trời lại sáng ???
Nhấp chuột vào đây để mở rộng...
Thoải mái bạn nhé. Thêm vật tư (Code Item) mới hay Hợp Đồng mới bao
nhiêu cũng được, không giới hạn và không phải chỉnh gì trong macro.
Bạn cứ nhập bình thường vào 2 sheet Nhập/Xuất (nhớ điền Tên HĐ cho dòng
Nhập và Tồn Đầu) rồi bấm nút — macro tự nhận Code và HĐ mới, tự thêm
vào bảng kết quả.

Chỉ cần gõ tên Code Item và Tên HĐ cho nhất quán (viết giống nhau) để
nó gộp đúng vào một mối.
 
À, xin lỗi bạn Ngày mai trời lại sáng, mình chỉ quan tâm các loại thép 1420120, 1620120, 2020120, 2520120 thôi vì các loại thép này có tồn và nhiều HD, còn các loại thép khác nhập bao nhiêu xuất bấy nhiêu (18,22,28,30,32,...vvv 90) nên không cần HD,mong bạn hiểu.
Ngày mai trời lại sáng đã viết:
Thoải mái bạn nhé. Thêm vật tư (Code Item) mới hay Hợp Đồng mới bao
nhiêu cũng được, không giới hạn và không phải chỉnh gì trong macro.
Bạn cứ nhập bình thường vào 2 sheet Nhập/Xuất (nhớ điền Tên HĐ cho dòng
Nhập và Tồn Đầu) rồi bấm nút — macro tự nhận Code và HĐ mới, tự thêm
vào bảng kết quả.

Chỉ cần gõ tên Code Item và Tên HĐ cho nhất quán (viết giống nhau) để
nó gộp đúng vào một mối.
Nhấp chuột vào đây để mở rộng...
mai
Bài đã được tự động gộp:

ptm0412 đã viết:
Có lẽ bạn nên tự thử thêm mặt hàng, thêm nhập, thêm xuất, ... trước khi hỏi. Động tay động chân, động não 1 chút.
Nhấp chuột vào đây để mở rộng...
Xin lỗi thầy Phạm Thế Mỹ.!!!!
 
Xin lỗi bạn Ngày mai trời lại sáng,đúng là nhập vào phải có HD nha, Cám ơn bạn.
Bài đã được tự động gộp:

Đúng là AI vẫn thua con người, bài này nhờ AI cả tuần không làm ra. !!!!!
 
Lần chỉnh sửa cuối:
DMQ đã viết:
Cám ơn bạn Ngày mai trời lại sáng nha!!!!
Mình thử thấy OK rồi, sheet ChiTiet_LIFO là bảng phụ hả bạn,không làm gì trên sheet này phải không bạn. Cám ơn bạn nhiều.
Bài này dùng công thức chắc không được bạn nhỉ.
À, sao mấy số có dấu chấm đằng sau là sao bạn?
Bài đã được tự động gộp:

À bạn ơi,ở sheet Ton_LIFO mình copy tay từ sheet Nhap và Sheet Xuat qua rồi Sort tăng dần theo ngày đó, vậy code có thể làm luôn được không bạn Ngày mai trời lại sáng??
Nhấp chuột vào đây để mở rộng...
Về câu hỏi dùng công thức của bạn: được nha, Excel 2010 công thức thuần
vẫn tính được tồn LIFO theo HĐ, không cần hàm đời mới.

Mình gửi file demo: sheet "CongThuc" tính hoàn toàn bằng công thức (cột
phụ tô xám, cột H nhập bằng Ctrl+Shift+Enter), bên cạnh có bảng đối
chiếu với kết quả macro — khớp 100%. Bạn thử thêm giao dịch rồi bấm nút
"Cập nhật LIFO" sẽ thấy hai bên cùng đổi theo.

Tuy vậy dùng hằng ngày mình vẫn khuyên bản VBA: công thức không tự gộp
Nhập/Xuất và sort được, không có bảng truy vết, lại dễ hỏng khi chèn/xóa
dòng. Công thức xem như lời giải tham khảo cho vui thôi nhé.
 

File đính kèm

  • Yêu thích
Reactions: DMQ
Cám ơn bạn Ngày mai trời lại sáng!!!!
 
DMQ đã viết:
Chào các anh chị!!!!
Em có file Excel tính tồn theo Hợp Đồng (HD) của thép tấm,mong các anh chị giúp đỡ.
Trong file sheet Ton_LIFO em có mô tả,mong anh chị giúp.
Em Cám Ơn!!!
Nhấp chuột vào đây để mở rộng...
Với dữ liệu đẹp như sheet Ton_LiFo có thể dùng sub
Mã: 
Sub TonLiFo()
  Dim aTon(), arr(), res(), dic As Object, sh As Worksheet
  Dim srTon&, sRow&, i&, r&, lR&, ik&, sl#, key$

  Set dic = CreateObject("Scripting.Dictionary")
  Set sh = Sheets("Ton_LIFO")
 
  lR = sh.Range("G" & Rows.Count).End(xlUp).Row
  If lR < 5 Then MsgBox ("Thieu du lieu ket qua!"): Exit Sub
  sh.Range("I5:I" & lR).ClearContents 'Xoa ket qua cu
  aTon = sh.Range("G5:H" & lR).Value
  srTon = UBound(aTon)
  ReDim res(1 To srTon, 1 To 1)
  For i = 1 To srTon
    dic(aTon(i, 1) & "_" & aTon(i, 2)) = i
  Next i
 
  lR = sh.Range("A" & Rows.Count).End(xlUp).Row
  If lR < 5 Then MsgBox ("Khong co du lieu!"): Exit Sub
  arr = sh.Range("A5:E" & lR).Value
  sRow = UBound(arr)
  For i = 1 To sRow
    sl = arr(i, 4)
    If arr(i, 2) Like "Xu?t" Then
      For r = i - 1 To 1 Step -1
        If Not (arr(r, 2) Like "Xu?t") Then
          If arr(i, 3) = arr(r, 3) And arr(r, 4) > 0 Then
            key = arr(r, 3) & "_" & arr(r, 5)
            If dic.exists(key) Then
              ik = dic(key) 'dong ket qua
              If arr(r, 4) >= sl Then
                res(ik, 1) = res(ik, 1) - sl
                arr(r, 4) = arr(r, 4) - sl
                sl = 0
                Exit For
              Else
                res(ik, 1) = res(ik, 1) - arr(r, 4)
                sl = sl - arr(r, 4)
                arr(r, 4) = 0
              End If
            End If
          End If
        End If
      Next r
      If r = 0 And sl > 0 Then
        MsgBox ("Item: " & arr(i, 3) & " Khong du hang ton kho de xuat!"): Exit Sub
      End If
    Else
      key = arr(i, 3) & "_" & arr(i, 5)
      If dic.exists(key) Then
        ik = dic(key)
        res(ik, 1) = res(ik, 1) + sl
      End If
    End If
  Next i
  sh.Range("I5").Resize(srTon) = res
End
Mã:
 
Sao code anh HieuCD lại báo 1420120 không đủ xuất. Vẫn tồn 13 tờ mà. Code anh không cần luôn sheet Chitiet_LIFO hả anh????
 
HieuCD đã viết:
Với dữ liệu đẹp như sheet Ton_LiFo có thể dùng sub
Mã: 
Sub TonLiFo()
  Dim aTon(), arr(), res(), dic As Object, sh As Worksheet
  Dim srTon&, sRow&, i&, r&, lR&, ik&, sl#, key$

  Set dic = CreateObject("Scripting.Dictionary")
  Set sh = Sheets("Ton_LIFO")
 
  lR = sh.Range("G" & Rows.Count).End(xlUp).Row
  If lR < 5 Then MsgBox ("Thieu du lieu ket qua!"): Exit Sub
  sh.Range("I5:I" & lR).ClearContents 'Xoa ket qua cu
  aTon = sh.Range("G5:H" & lR).Value
  srTon = UBound(aTon)
  ReDim res(1 To srTon, 1 To 1)
  For i = 1 To srTon
    dic(aTon(i, 1) & "_" & aTon(i, 2)) = i
  Next i
 
  lR = sh.Range("A" & Rows.Count).End(xlUp).Row
  If lR < 5 Then MsgBox ("Khong co du lieu!"): Exit Sub
  arr = sh.Range("A5:E" & lR).Value
  sRow = UBound(arr)
  For i = 1 To sRow
    sl = arr(i, 4)
    If arr(i, 2) Like "Xu?t" Then
      For r = i - 1 To 1 Step -1
        If Not (arr(r, 2) Like "Xu?t") Then
          If arr(i, 3) = arr(r, 3) And arr(r, 4) > 0 Then
            key = arr(r, 3) & "_" & arr(r, 5)
            If dic.exists(key) Then
              ik = dic(key) 'dong ket qua
              If arr(r, 4) >= sl Then
                res(ik, 1) = res(ik, 1) - sl
                arr(r, 4) = arr(r, 4) - sl
                sl = 0
                Exit For
              Else
                res(ik, 1) = res(ik, 1) - arr(r, 4)
                sl = sl - arr(r, 4)
                arr(r, 4) = 0
              End If
            End If
          End If
        End If
      Next r
      If r = 0 And sl > 0 Then
        MsgBox ("Item: " & arr(i, 3) & " Khong du hang ton kho de xuat!"): Exit Sub
      End If
    Else
      key = arr(i, 3) & "_" & arr(i, 5)
      If dic.exists(key) Then
        ik = dic(key)
        res(ik, 1) = res(ik, 1) + sl
      End If
    End If
  Next i
  sh.Range("I5").Resize(srTon) = res
End
Mã:
Nhấp chuột vào đây để mở rộng...
Em xem thấy có một tình huống nhỏ có thể bổ sung thêm để code an toàn hơn: đoạn If dic.Exists(key) Then hiện đang bao luôn phần trừ arr(r, 4), nên nếu bảng G:H chưa có một Code/HĐ thì lớp hàng đó có thể bị bỏ qua khi xuất, từ đó có khả năng báo thiếu tồn dù thực tế vẫn còn hàng.

Theo em có thể tách phần trừ LIFO ra độc lập với dic, còn dic chỉ dùng để ghi kết quả; nếu thiếu key thì tự bổ sung G:H hoặc báo rõ Thiếu Code/HĐ ... để người dùng kiểm tra.

Cách anh làm rất ngắn gọn và dễ theo dõi, em học thêm được một hướng xử lý hay.
 
DMQ đã viết:
Sao code anh HieuCD lại báo 1420120 không đủ xuất. Vẫn tồn 13 tờ mà. Code anh không cần luôn sheet Chitiet_LIFO hả anh????
Nhấp chuột vào đây để mở rộng...
Chỉ dùng dữ liệu của sheet Ton_LiFo
File mình không báo kết quả Âm, và kết quả tồn 6 của 1420120
Bài đã được tự động gộp:

Ngày mai trời lại sáng đã viết:
Em xem thấy có một tình huống nhỏ có thể bổ sung thêm để code an toàn hơn: đoạn If dic.Exists(key) Then hiện đang bao luôn phần trừ arr(r, 4), nên nếu bảng G:H chưa có một Code/HĐ thì lớp hàng đó có thể bị bỏ qua khi xuất, từ đó có khả năng báo thiếu tồn dù thực tế vẫn còn hàng.

Theo em có thể tách phần trừ LIFO ra độc lập với dic, còn dic chỉ dùng để ghi kết quả; nếu thiếu key thì tự bổ sung G:H hoặc báo rõ Thiếu Code/HĐ ... để người dùng kiểm tra.

Cách anh làm rất ngắn gọn và dễ theo dõi, em học thêm được một hướng xử lý hay.
Nhấp chuột vào đây để mở rộng...
Code mình không tạo key mới nghiệp vụ phát sinh, chỉ sử dụng key theo yêu cầu trong sheet Ton_LiFo
 

File đính kèm

HieuCD đã viết:
Chỉ dùng dữ liệu của sheet Ton_LiFo
File mình không báo kết quả Âm, và kết quả tồn 6 của 1420120
Bài đã được tự động gộp:


Code mình không tạo key mới nghiệp vụ phát sinh, chỉ sử dụng key theo yêu cầu trong sheet Ton_LiFo
Nhấp chuột vào đây để mở rộng...
Sheet Ton_LIFO là em copy từ sheet Nhap và sheet Xuat qua rồi sort tăng dần theo ngày anh HieuCD, nhờ anh tạo key mới nghiệp vụ phát sinh luôn dùm.
 
Số liệu tồn đầu kỳ em gõ vào ở dòng 5,6,7 sheet Ton_LIFO ạ.
 
DMQ đã viết:
Số liệu tồn đầu kỳ em gõ vào ở dòng 5,6,7 sheet Ton_LIFO ạ.
Nhấp chuột vào đây để mở rộng...
Kiểm tra lại. . . .
Mã: 
Sub TonLiFo()
  Dim arr(), aXuat(), aTon(), aNhap(), res(), dic As Object
  Dim srXuat&, sRow&, fr&, i&, r&, k&, t&, ik&, sl#, key$, ngay

  Set dic = CreateObject("Scripting.Dictionary")
  With Sheets("Xuat")
    i = .Range("G" & Rows.Count).End(xlUp).Row
    If i < 3 Then i = 3
    aXuat = .Range("C3:K" & i).Value
  End With
  With Sheets("Nhap")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i < 3 Then i = 3 'Dong du lieu dau
    arr = .Range("A3:M" & i).Value
    sRow = UBound(arr) 'So dong du lieu Nhap
  End With
  With Sheets("Ton_LiFo")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i < 5 Then i = 5
    aTon = .Range("B5:C" & i).Value
    For i = 1 To UBound(aTon)
      If aTon(i, 1) Like "T?n ??u" Then r = r + 1 Else Exit For
    Next i
    aNhap = .Range("A5:E5").Resize(sRow + r).Value
  End With
 
  For i = 1 To sRow 'Ghep mang ton dau và mang nhap kho
    If arr(i, 1) <> Empty Then
      r = r + 1
      aNhap(r, 1) = arr(i, 1): aNhap(r, 3) = arr(i, 4)
      aNhap(r, 4) = arr(i, 10): aNhap(r, 5) = arr(i, 13)
    End If
  Next i
  sRow = UBound(aNhap):     srXuat = UBound(aXuat)

  fr = 1
  For i = 1 To srXuat 'Tinh dong du lieu xuat tu mang nhap
    If aXuat(i, 1) = ngay Then
      aXuat(i, 2) = aXuat(i - 1, 2)
    Else
      ngay = aXuat(i, 1)
      t = 0
      For r = fr To sRow
        If ngay >= aNhap(r, 1) Then t = r Else Exit For
      Next r
      aXuat(i, 2) = t
      fr = r - 1 '***
    End If
  Next i
 
  ReDim res(1 To sRow, 1 To 3)
  For i = 1 To sRow 'Tao mang ket qua voi tong so luong (Ton + Nhap)
    dic(aNhap(i, 3)) = ""
    key = aNhap(i, 3) & "|" & aNhap(i, 5)
    If dic.exists(key) = False Then
      k = k + 1
      dic.Add key, k
      res(k, 1) = aNhap(i, 3)
      res(k, 2) = aNhap(i, 5)
    End If
    ik = dic(key)
    res(ik, 3) = res(ik, 3) + aNhap(i, 4)
  Next i
 
  For i = 1 To srXuat 'Tính ton kho
    If dic.exists(aXuat(i, 5)) = False Then
      MsgBox ("Item: " & aXuat(i, 5) & " Khong có hang ton kho de xuat!")
    Else
      ik = 0
      sl = aXuat(i, 9)
      For r = aXuat(i, 2) To 1 Step -1
        If aNhap(r, 3) = aXuat(i, 5) Then
          ik = dic(aNhap(r, 3) & "|" & aNhap(r, 5)) 'dong ket qua ****
          If aNhap(r, 4) > 0 Then
            If aNhap(r, 4) >= sl Then
              res(ik, 3) = res(ik, 3) - sl
              aNhap(r, 4) = aNhap(r, 4) - sl
              sl = 0
              Exit For
            Else
              res(ik, 3) = res(ik, 3) - aNhap(r, 4)
              sl = sl - aNhap(r, 4)
              aNhap(r, 4) = 0
            End If
          End If
        End If
      Next r
      If r = 0 And sl > 0 Then
        MsgBox ("Item: " & aXuat(i, 5) & " Ngay " & aXuat(i, 1) & " Khong du hang ton kho de xuat!")
        If ik > 0 Then res(ik, 3) = res(ik, 3) - sl
      End If
    End If
  Next i
 
  With Sheets("Ton_LiFo")
    i = .Range("G" & Rows.Count).End(xlUp).Row
    If i >= 5 Then .Range("G5:I" & i).Clear
    .Range("G5").Resize(k).NumberFormat = "@"
    .Range("G5:I5").Resize(k) = res
    .Range("G5:I5").Resize(k).Sort .Range("G5"), 1, Header:=xlNo
    .Range("G5:I5").Resize(k).Borders.LineStyle = 1
  End With
End Sub
 

File đính kèm

Thành thật xin lỗi anh HieuCD!!!! cột D sheet nhap và cột G sheet xuat thực tế của em có rất nhiều mã vật tư, file kia là em lọc ra chỉ thép tâm dày thôi, nhung đặc điểm là thép dày cần trừ theo HD là lúc nào cũng có 7 số (1420120,1620120,2020120,2520120..v.....vv) 5 số cuối là rộng và dài của thép (20120- rộng 2000mm, dài 12000mm), còn 2 số đầu là dày của thép như 14mm, 16mm..vv...vv. Còn thép dày dưới 14mm không cần tính trừ theo hợp đồng. Bảng A:E trong sheet Ton_LIFO em đang làm thủ công bằng tay, mong anh HieuCD dùng code luôn.
Em xin gửi lại file.
 

File đính kèm

DMQ đã viết:
Thành thật xin lỗi anh HieuCD!!!! cột D sheet nhap và cột G sheet xuat thực tế của em có rất nhiều mã vật tư, file kia là em lọc ra chỉ thép tâm dày thôi, nhung đặc điểm là thép dày cần trừ theo HD là lúc nào cũng có 7 số (1420120,1620120,2020120,2520120..v.....vv) 5 số cuối là rộng và dài của thép (20120- rộng 2000mm, dài 12000mm), còn 2 số đầu là dày của thép như 14mm, 16mm..vv...vv. Còn thép dày dưới 14mm không cần tính trừ theo hợp đồng. Bảng A:E trong sheet Ton_LIFO em đang làm thủ công bằng tay, mong anh HieuCD dùng code luôn.
Em xin gửi lại file.
Nhấp chuột vào đây để mở rộng...
"Còn thép dày dưới 14mm không cần tính trừ theo hợp đồng." là sao?
Có tính trừ chung không? Hay là bỏ luôn không đưa vào kết quả?
 
  • Yêu thích
Reactions: DMQ
Dạ bỏ luôn ạ, không đưa vào kết quả. Mong anh HieuCD giúp!!!!
 
DMQ đã viết:
Dạ bỏ luôn ạ, không đưa vào kết quả. Mong anh HieuCD giúp!!!!
Nhấp chuột vào đây để mở rộng...
Sheet Ton_LiFo chỉ cần các dòng "Tồn đầu"
Kiểm tra lại
Mã: 
Sub TonLiFo()
  Dim arr(), aXuat(), aTon(), aNhap(), res(), dic As Object
  Dim srXuat&, sRow&, fr&, i&, r&, k&, t&, ik&, sl#, iTem$, key$, ngay

  Set dic = CreateObject("Scripting.Dictionary")
  With Sheets("Xuat")
    i = .Range("G" & Rows.Count).End(xlUp).Row
    If i < 6 Then i = 6
    aXuat = .Range("C6:K" & i).Value
  End With
  With Sheets("Nhap")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i < 5 Then i = 5 'Dong du lieu dau
    arr = .Range("A3:M" & i).Value
    sRow = UBound(arr) 'So dong du lieu Nhap
  End With
  With Sheets("Ton_LiFo")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i < 5 Then i = 5
    aTon = .Range("B5:C" & i).Value
    For i = 1 To UBound(aTon)
      If aTon(i, 1) Like "T?n ??u" Then r = r + 1 Else Exit For
    Next i
    aNhap = .Range("A5:E5").Resize(sRow + r).Value
  End With
 
  For i = 1 To sRow 'Ghep mang ton dau và mang nhap kho
    iTem = arr(i, 4)
    If Len(iTem) = 7 And IsNumeric(iTem) Then
      If CLng(Left(iTem, 2)) >= 14 Then
        r = r + 1
        aNhap(r, 1) = arr(i, 1): aNhap(r, 3) = iTem
        aNhap(r, 4) = arr(i, 10): aNhap(r, 5) = arr(i, 13)
      End If
    End If
  Next i
  sRow = r:     srXuat = UBound(aXuat)

  fr = 1
  For i = 1 To srXuat 'Tinh dong du lieu xuat tu mang nhap
    If aXuat(i, 1) = ngay Then
      aXuat(i, 2) = aXuat(i - 1, 2)
    Else
      ngay = aXuat(i, 1)
      t = 0
      For r = fr To sRow
        If ngay >= aNhap(r, 1) Then t = r Else Exit For
      Next r
      aXuat(i, 2) = t
      fr = r - 1 '***
    End If
  Next i
 
  ReDim res(1 To sRow, 1 To 3)
  For i = 1 To sRow 'Tao mang ket qua voi tong so luong (Ton + Nhap)
    iTem = aNhap(i, 3)
    If dic.exists(iTem) = False Then dic(iTem) = ""
    key = iTem & "|" & aNhap(i, 5)
    If dic.exists(key) = False Then
      k = k + 1
      dic.Add key, k
      res(k, 1) = iTem
      res(k, 2) = aNhap(i, 5)
      If dic(iTem) = "" Then dic(iTem) = k
    End If
    ik = dic(key)
    res(ik, 3) = res(ik, 3) + aNhap(i, 4)
  Next i
 
  For i = 1 To srXuat 'Tính ton kho
    iTem = aXuat(i, 5)
    If Len(iTem) = 7 And IsNumeric(iTem) Then
      If CLng(Left(iTem, 2)) >= 14 Then
        If dic.exists(iTem) = False Then
          MsgBox ("Item: " & iTem & " Khong có hang ton kho de xuat!")
        End If
        ik = 0
        sl = aXuat(i, 9)
        For r = aXuat(i, 2) To 1 Step -1
          If aNhap(r, 3) = iTem Then
            ik = dic(aNhap(r, 3) & "|" & aNhap(r, 5)) 'dong ket qua ****
            If aNhap(r, 4) > 0 Then
              If aNhap(r, 4) >= sl Then
                res(ik, 3) = res(ik, 3) - sl
                aNhap(r, 4) = aNhap(r, 4) - sl
                sl = 0
                Exit For
              Else
                res(ik, 3) = res(ik, 3) - aNhap(r, 4)
                sl = sl - aNhap(r, 4)
                aNhap(r, 4) = 0
              End If
            End If
          End If
        Next r
        If r = 0 And sl > 0 Then
          MsgBox ("Item: " & iTem & " Ngay " & aXuat(i, 1) & " Khong du hang ton kho de xuat!")
          If ik = 0 Then ik = dic(iTem)
          res(ik, 3) = res(ik, 3) - sl
        End If
      End If
    End If
  Next i
 
  With Sheets("Ton_LiFo")
    i = .Range("G" & Rows.Count).End(xlUp).Row
    If i >= 5 Then .Range("G5:I" & i).Clear
    .Range("G5").Resize(k).NumberFormat = "@"
    .Range("G5:I5").Resize(k) = res
    .Range("G5:I5").Resize(k).Sort .Range("G5"), 1, Header:=xlNo
    .Range("G5:I5").Resize(k).Borders.LineStyle = 1
  End With
End Sub
 
Ngày mai trời lại sáng đã viết:
Chào bạn,
Mình làm thử bằng VBA theo nguyên tắc LIFO theo từng Code Item và Hợp đồng.
Khi xuất, chương trình sẽ trừ từ lô nhập gần nhất trước; nếu không đủ sẽ tự động trừ tiếp lô trước đó.
Bạn tải file đính kèm chạy thử xem có đúng với yêu cầu thực tế không nhé.
Nhấp chuột vào đây để mở rộng...
Hóng phương pháp FIFO xuất bản từ anh!
 
Mình gửi file bổ xung thêm phương pháp FIFO:

• Sheet Ton_LIFO: một bảng giao dịch chung + 3 nút. Bấm "Cập nhật cả hai"
là thấy tồn theo HĐ của CẢ hai phương pháp nằm cạnh nhau: LIFO ở G:I
(trừ lô MỚI nhất trước) và FIFO ở K:M (trừ lô CŨ nhất trước).
• Có sẵn mã TEST01 để xem các ca khó: xuất vượt tồn (dòng [THIẾU TỒN]
tô đỏ).

Hai sheet công thức chỉ để chứng minh/đối chiếu cho vui, dữ liệu lớn hay dùng hằng ngày thì vẫn nên bấm nút VBA nhé.
 

File đính kèm

E
HieuCD đã viết:
Sheet Ton_LiFo chỉ cần các dòng "Tồn đầu"
Kiểm tra lại
Mã: 
Sub TonLiFo()
  Dim arr(), aXuat(), aTon(), aNhap(), res(), dic As Object
  Dim srXuat&, sRow&, fr&, i&, r&, k&, t&, ik&, sl#, iTem$, key$, ngay

  Set dic = CreateObject("Scripting.Dictionary")
  With Sheets("Xuat")
    i = .Range("G" & Rows.Count).End(xlUp).Row
    If i < 6 Then i = 6
    aXuat = .Range("C6:K" & i).Value
  End With
  With Sheets("Nhap")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i < 5 Then i = 5 'Dong du lieu dau
    arr = .Range("A3:M" & i).Value
    sRow = UBound(arr) 'So dong du lieu Nhap
  End With
  With Sheets("Ton_LiFo")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i < 5 Then i = 5
    aTon = .Range("B5:C" & i).Value
    For i = 1 To UBound(aTon)
      If aTon(i, 1) Like "T?n ??u" Then r = r + 1 Else Exit For
    Next i
    aNhap = .Range("A5:E5").Resize(sRow + r).Value
  End With
 
  For i = 1 To sRow 'Ghep mang ton dau và mang nhap kho
    iTem = arr(i, 4)
    If Len(iTem) = 7 And IsNumeric(iTem) Then
      If CLng(Left(iTem, 2)) >= 14 Then
        r = r + 1
        aNhap(r, 1) = arr(i, 1): aNhap(r, 3) = iTem
        aNhap(r, 4) = arr(i, 10): aNhap(r, 5) = arr(i, 13)
      End If
    End If
  Next i
  sRow = r:     srXuat = UBound(aXuat)

  fr = 1
  For i = 1 To srXuat 'Tinh dong du lieu xuat tu mang nhap
    If aXuat(i, 1) = ngay Then
      aXuat(i, 2) = aXuat(i - 1, 2)
    Else
      ngay = aXuat(i, 1)
      t = 0
      For r = fr To sRow
        If ngay >= aNhap(r, 1) Then t = r Else Exit For
      Next r
      aXuat(i, 2) = t
      fr = r - 1 '***
    End If
  Next i
 
  ReDim res(1 To sRow, 1 To 3)
  For i = 1 To sRow 'Tao mang ket qua voi tong so luong (Ton + Nhap)
    iTem = aNhap(i, 3)
    If dic.exists(iTem) = False Then dic(iTem) = ""
    key = iTem & "|" & aNhap(i, 5)
    If dic.exists(key) = False Then
      k = k + 1
      dic.Add key, k
      res(k, 1) = iTem
      res(k, 2) = aNhap(i, 5)
      If dic(iTem) = "" Then dic(iTem) = k
    End If
    ik = dic(key)
    res(ik, 3) = res(ik, 3) + aNhap(i, 4)
  Next i
 
  For i = 1 To srXuat 'Tính ton kho
    iTem = aXuat(i, 5)
    If Len(iTem) = 7 And IsNumeric(iTem) Then
      If CLng(Left(iTem, 2)) >= 14 Then
        If dic.exists(iTem) = False Then
          MsgBox ("Item: " & iTem & " Khong có hang ton kho de xuat!")
        End If
        ik = 0
        sl = aXuat(i, 9)
        For r = aXuat(i, 2) To 1 Step -1
          If aNhap(r, 3) = iTem Then
            ik = dic(aNhap(r, 3) & "|" & aNhap(r, 5)) 'dong ket qua ****
            If aNhap(r, 4) > 0 Then
              If aNhap(r, 4) >= sl Then
                res(ik, 3) = res(ik, 3) - sl
                aNhap(r, 4) = aNhap(r, 4) - sl
                sl = 0
                Exit For
              Else
                res(ik, 3) = res(ik, 3) - aNhap(r, 4)
                sl = sl - aNhap(r, 4)
                aNhap(r, 4) = 0
              End If
            End If
          End If
        Next r
        If r = 0 And sl > 0 Then
          MsgBox ("Item: " & iTem & " Ngay " & aXuat(i, 1) & " Khong du hang ton kho de xuat!")
          If ik = 0 Then ik = dic(iTem)
          res(ik, 3) = res(ik, 3) - sl
        End If
      End If
    End If
  Next i
 
  With Sheets("Ton_LiFo")
    i = .Range("G" & Rows.Count).End(xlUp).Row
    If i >= 5 Then .Range("G5:I" & i).Clear
    .Range("G5").Resize(k).NumberFormat = "@"
    .Range("G5:I5").Resize(k) = res
    .Range("G5:I5").Resize(k).Sort .Range("G5"), 1, Header:=xlNo
    .Range("G5:I5").Resize(k).Borders.LineStyle = 1
  End With
End Sub
Nhấp chuột vào đây để mở rộng...
Em cám ơn anh HieuCD nhiều!!!!
Bài đã được tự động gộp:

Mong anh HieuCD làm dùm ở bảng kết quả cuối mỗi nhóm vật tư chèn 1 dòng tổng, tô màu, cột H có chữ "ToTal", cột I là tổng số lượng của vật tư của các loại hợp đồng.
 
Lần chỉnh sửa cuối:
DMQ đã viết:
E

Em cám ơn anh HieuCD nhiều!!!!
Bài đã được tự động gộp:

Mong anh HieuCD làm dùm ở bảng kết quả cuối mỗi nhóm vật tư chèn 1 dòng tổng, tô màu, cột H có chữ "ToTal", cột I là tổng số lượng của vật tư của các loại hợp đồng.
Nhấp chuột vào đây để mở rộng...
xác định nhóm như thế nào?
 
HieuCD đã viết:
xác định nhóm như thế nào?
Nhấp chuột vào đây để mở rộng...
Xác định theo code Item đó anh,ví dụ 1420120 có tới 5 hợp đồng, thì dòng thứ 6 là ToTal số lượng tổng tấm của 5 hợp đồng của 1420120, rồi 1620120 có 3 hợp đồng thì dòng cuối sẽ là Total số lượng tổng tấm của 3 hợp đồng của1620120. Mong anh HieuCD giúp.
 
DMQ đã viết:
Xác định theo code Item đó anh,ví dụ 1420120 có tới 5 hợp đồng, thì dòng thứ 6 là ToTal số lượng tổng tấm của 5 hợp đồng của 1420120, rồi 1620120 có 3 hợp đồng thì dòng cuối sẽ là Total số lượng tổng tấm của 3 hợp đồng của1620120. Mong anh HieuCD giúp.
Nhấp chuột vào đây để mở rộng...
Bạn tải file rồi kiểm tra thử.
 

File đính kèm

DMQ đã viết:
Xác định theo code Item đó anh,ví dụ 1420120 có tới 5 hợp đồng, thì dòng thứ 6 là ToTal số lượng tổng tấm của 5 hợp đồng của 1420120, rồi 1620120 có 3 hợp đồng thì dòng cuối sẽ là Total số lượng tổng tấm của 3 hợp đồng của1620120. Mong anh HieuCD giúp.
Nhấp chuột vào đây để mở rộng...
Thêm dòng Total . . .
Mã: 
Sub TonLiFo()
  Dim arr(), aXuat(), aTon(), aNhap(), res(), dic As Object
  Dim srXuat&, sRow&, fr&, i&, r&, k&, t&, n&, ik&, sl#, iTem$, key$, ngay

  Set dic = CreateObject("Scripting.Dictionary")
  With Sheets("Xuat")
    i = .Range("G" & Rows.Count).End(xlUp).Row
    If i < 6 Then i = 6
    aXuat = .Range("C6:K" & i).Value
  End With
  With Sheets("Nhap")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i < 5 Then i = 5 'Dong du lieu dau
    arr = .Range("A3:M" & i).Value
    sRow = UBound(arr) 'So dong du lieu Nhap
  End With
  With Sheets("Ton_LiFo")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i < 5 Then i = 5
    aTon = .Range("B5:C" & i).Value
    For i = 1 To UBound(aTon)
      If aTon(i, 1) Like "T?n ??u" Then r = r + 1 Else Exit For
    Next i
    aNhap = .Range("A5:E5").Resize(sRow + r).Value
  End With
 
  For i = 1 To sRow 'Ghep mang ton dau và mang nhap kho
    iTem = arr(i, 4)
    If Len(iTem) = 7 And IsNumeric(iTem) Then
      If CLng(Left(iTem, 2)) >= 14 Then
        r = r + 1
        aNhap(r, 1) = arr(i, 1): aNhap(r, 3) = iTem
        aNhap(r, 4) = arr(i, 10): aNhap(r, 5) = arr(i, 13)
      End If
    End If
  Next i
  sRow = r:     srXuat = UBound(aXuat)

  fr = 1
  For i = 1 To srXuat 'Tinh dong du lieu xuat tu mang nhap
    If aXuat(i, 1) = ngay Then
      aXuat(i, 2) = aXuat(i - 1, 2)
    Else
      ngay = aXuat(i, 1)
      t = 0
      For r = fr To sRow
        If ngay >= aNhap(r, 1) Then t = r Else Exit For
      Next r
      aXuat(i, 2) = t
      fr = r - 1 '***
    End If
  Next i
 
  ReDim res(1 To sRow, 1 To 3)
  For i = 1 To sRow 'Tao mang ket qua voi tong so luong (Ton + Nhap)
    iTem = aNhap(i, 3)
    If dic.exists(iTem) = False Then
      dic(iTem) = ""
      n = n + 1
    End If
    key = iTem & "|" & aNhap(i, 5)
    If dic.exists(key) = False Then
      k = k + 1
      dic.Add key, k
      res(k, 1) = iTem
      res(k, 2) = aNhap(i, 5)
      If dic(iTem) = "" Then dic(iTem) = k
    End If
    ik = dic(key)
    res(ik, 3) = res(ik, 3) + aNhap(i, 4)
  Next i
 
  For i = 1 To srXuat 'Tính ton kho
    iTem = aXuat(i, 5)
    If Len(iTem) = 7 And IsNumeric(iTem) Then
      If CLng(Left(iTem, 2)) >= 14 Then
        If dic.exists(iTem) = False Then
          MsgBox ("Item: " & iTem & " Khong có hang ton kho de xuat!")
        End If
        ik = 0
        sl = aXuat(i, 9)
        For r = aXuat(i, 2) To 1 Step -1
          If aNhap(r, 3) = iTem Then
            ik = dic(aNhap(r, 3) & "|" & aNhap(r, 5)) 'dong ket qua ****
            If aNhap(r, 4) > 0 Then
              If aNhap(r, 4) >= sl Then
                res(ik, 3) = res(ik, 3) - sl
                aNhap(r, 4) = aNhap(r, 4) - sl
                sl = 0
                Exit For
              Else
                res(ik, 3) = res(ik, 3) - aNhap(r, 4)
                sl = sl - aNhap(r, 4)
                aNhap(r, 4) = 0
              End If
            End If
          End If
        Next r
        If r = 0 And sl > 0 Then
          MsgBox ("Item: " & iTem & " Ngay " & aXuat(i, 1) & " Khong du hang ton kho de xuat!")
          If ik = 0 Then ik = dic(iTem)
          res(ik, 3) = res(ik, 3) - sl
        End If
      End If
    End If
  Next i
  Application.ScreenUpdating = False
  With Sheets("Ton_LiFo")
    i = .Range("G" & Rows.Count).End(xlUp).Row
    If i >= 5 Then .Range("G5:I" & i).Clear
    .Range("G5").Resize(k + n).NumberFormat = "@"
    .Range("G5:I5").Resize(k) = res
    .Range("G5:I5").Resize(k).Sort .Range("G5"), 1, Header:=xlNo
    t = k + n
    res = .Range("G5:I5").Resize(t).Value
    iTem = Empty
    For i = k To 1 Step -1
      If iTem <> res(i, 1) Then
        iTem = res(i, 1)
        res(t, 1) = "ToTal":  res(t, 2) = Empty:  res(t, 3) = Empty
        r = t:                 t = t - 1
      End If
      res(t, 1) = res(i, 1): res(t, 2) = res(i, 2)
      res(t, 3) = res(i, 3)
      t = t - 1
      res(r, 3) = res(r, 3) + res(i, 3)
    Next i
    .Range("G5").Resize(UBound(res), 3) = res
    .Range("G5:I5").Resize(k + n).Borders.LineStyle = 1
    For i = 5 To UBound(res) + n
      If .Range("G" & i) = "ToTal" Then
        .Range("G" & i).Resize(, 2).Merge
        '.Range("G" & i).HorizontalAlignment = xlCenter
      End If
    Next i
  End With
  Application.ScreenUpdating = True
End Sub
 
Cám ơn anh HieuCD nhiều !!!!!
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

Ngày mai trời lại sáng
  • Question Question
[Chia sẻ] Ứng dụng Excel quản lý suất ăn đoàn cho nhà hàng (4 người xem)
    • Thích
Trả lời
1
Đọc
17
ongke0711
ongke0711
ongke0711
Vào diễn đàn rất chậm (2 người xem)
    • Thích
    • Chấp nhận
Trả lời
5
Đọc
154
ongke0711
ongke0711
DMQ
Tại sao cùng FIle,cùng code VBA mà ở máy này chạy đúng,máy kia chạy sai. (1 người xem)
    • Cười
    • Thích
Trả lời
10
Đọc
370
ongke0711
ongke0711
thaipv
  • Question Question
#HookLab - Tạo cửa sổ TaskPane / ActionPane bằng UserForm (1 người xem)
    • Thích
Trả lời
74
Đọc
15K
Tuanba1992
Tuanba1992
hongphuong1997
Cảm ơn diễn đàn và đặc biệt bác @hieu CD
    • Thích
    • Yêu thích
    • Chấp nhận
Trả lời
5
Đọc
285
ptm0412
ptm0412
SA_DQ
[II] Nhờ Trí tuệ nhân tạo bàn luận về các ván cờ vua hàng ngày
    • Thích
Trả lời
32
Đọc
1K
SA_DQ
SA_DQ
Gà Công Nghệ
Tổng hợp từ sheet phụ sang sheet tổng (1 người xem)
Trả lời
14
Đọc
664
trum00thay
T
GPE-Trợ Lý
[HCM] ĐĂNG KÝ THAM DỰ SINH NHẬT GIAIPHAPEXCEL LẦN THỨ 20 NGÀY 20/09/2026 (2 người xem)
    • Thích
Trả lời
6
Đọc
809
xuantham
xuantham
K
[SHARE] File tính ngày công – Thứ 7 xen kẽ (chọn được quy tắc) + trừ lễ (dùng được nhiều năm)
Trả lời
0
Đọc
70
kttrandieo
K
Kiều Mạnh
Chia sẻ: Nhận diện giọng nói tiếng Việt Offline trong Excel (VBA + DLL) - Hỗ trợ WAV, MP3, MP4, M4A
    • Cảm ơn
    • Thích
Trả lời
1
Đọc
197
Kiều Mạnh
Kiều Mạnh
L
Tự động nhập dữ liệu từ sheet này sang sheet khác và ẩn ô giá trị ""
Trả lời
5
Đọc
169
longpnt
L
V
Quản lý thu chi bằng excel (Tặng cho những ai cần đến) (2 người xem)
    • Thích
Trả lời
71
Đọc
296K
Gà Con yêu VBA
Gà Con yêu VBA
GPE-Trợ Lý
[ĐÀ NẴNG] ĐĂNG KÝ THAM DỰ SINH NHẬT GIAIPHAPEXCEL LẦN THỨ 20 NGÀY 12/09/2026 (1 người xem)
    • Thích
    • Yêu thích
    • Chấp nhận
Trả lời
16
Đọc
1K
PhanTuHuong
PhanTuHuong
huuthang_bd
Add-in DeleteVirusMacro - Xóa và ngăn chặn virus macro
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
57
Đọc
26K
LKTECH
L
Nguyễn Duy Tuân
  • Dán lên cao
Phiên bản mới Add-in A-Tools AI v10 (2024) (2 người xem)
    • Thích
2
Trả lời
114
Đọc
22K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
H
xử lý dữ liệu trùng nhau trong excel (1 người xem)
Trả lời
10
Đọc
510
ptm0412
ptm0412
huuthang_bd
Add-in Input From List - Hỗ trợ nhập liệu từ danh mục có sẵn
    • Thích
    • Yêu thích
3 4 5
Trả lời
445
Đọc
145K
phamhuubi
P
GPE-Trợ Lý
ẢNH SỰ KIỆN SINH NHẬT TẠI HN 06/09/2026
    • Thích
Trả lời
0
Đọc
137
GPE-Trợ Lý
GPE-Trợ Lý
T
Excel nhớ lệnh copy cũ
Trả lời
3
Đọc
191
doanlong49
D
Maika8008
Chia sẻ - Python - Trộn dữ liệu bảng Excel sang file Word mẫu
    • Thích
Trả lời
12
Đọc
619
tuan16
T
Xem thêm…

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

Back
Top Bottom