Cách sử dụng Code tính giá FIFO

Liên hệ QC
HieuCD đã viết:
Code không cho phép tồn kho âm, nếu cho phép tồn kho âm thì bỏ dòng lệnh
If aNhap(r, 1) > Ngay Then Exit For 'Ton kho khong "Am"
Một số trường hợp không có hàng tồn kho để xuất nên kết quả tạm thời thêm cột "Số lượng chưa xuất"
Mã: 
Sub FIFO()
  Dim aNhap(), aXuat(), Arr(), Res()
  Dim srNhap&, srXuat&, i&, eRow&, Rk&
  Dim Ngay As Date, MaSP$, iTest As Boolean
  With Sheets("NHAP")
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    Arr = .Range("A4:H" & eRow).Value
    .Range("A4:H" & eRow).Sort .[C4], 1, .[A4], , 1, Header:=xlNo
    aNhap = .Range("A4:H" & eRow).Value
    .Range("A4:H" & eRow).Value = Arr
  End With
  srNhap = UBound(aNhap)
  With Sheets("XUAT")
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    .Range("I5:K" & eRow).ClearContents
    .Range("L5").Value = 1
    .Range("L5:L" & eRow).DataSeries
    .Range("A5:L" & eRow).Sort .[C5], 1, .[A5], , 1, Header:=xlNo
    aXuat = .Range("A5:F" & eRow).Value
  End With
  srXuat = UBound(aXuat)
  ReDim Res(1 To srXuat, 1 To 3)

  Rk = 1
  For i = 1 To srXuat
    MaSP = aXuat(i, 3)
    Ngay = aXuat(i, 1)
    Res(i, 3) = aXuat(i, 6)
    iTest = False
    For r = Rk To srNhap
      If aNhap(r, 3) = MaSP Then
        If aNhap(r, 1) > Ngay Then Exit For 'Ton kho khong "Am"
        iTest = True
        If aNhap(r, 6) > Res(i, 3) Then
          aNhap(r, 6) = aNhap(r, 6) - Res(i, 3)
          Res(i, 2) = Res(i, 2) + aNhap(r, 7) * Res(i, 3)
          Res(i, 3) = 0
          Exit For
        ElseIf aNhap(r, 6) > 0 Then
          Res(i, 2) = Res(i, 2) + aNhap(r, 6) * aNhap(r, 7)
          Res(i, 3) = Res(i, 3) - aNhap(r, 6)
          aNhap(r, 6) = 0
          Rk = r
          If Res(i, 3) = 0 Then Exit For
        End If
      Else
        If iTest = True Then Exit For
      End If
    Next r
  Next i
  For i = 1 To srXuat
    If Res(i, 2) > 0 Then Res(i, 1) = Round(Res(i, 2) / (aXuat(i, 6) - Res(i, 3)), 2)
    If Res(i, 3) = 0 Then Res(i, 3) = Empty
  Next i
  With Sheets("XUAT")
    .Range("I5").Resize(srXuat, 3) = Res 'Them cot so luong chua xuat duoc
    '.Range("I5").Resize(srXuat, 2) = Res
    .Range("A5:L" & eRow).Sort .[L5], 1, Header:=xlNo
    .Range("L5:L" & eRow).ClearContents
  End With
End Sub
Nhấp chuột vào đây để mở rộng...
Anh HiếuCD giúp viết marcro VBA tìm ngày hàng còn trong kho chưa bán Min ko. Nếu được mình cảm ơn trước tại có cả 30 mặt hàng như vậy tìm khá nhiều
 

File đính kèm

  • Sổ làm việc (3).xlsx
    10.7 KB · Đọc: 13
Hoan1985 đã viết:
Ngày Nhập. Xuất
1/1/2020 30. 0
2/1/2020 0. 10
3/1/2020. 0. 10
Vậy ngày Min hàng tồn kho chưa bán hết là 1/1/2020
Nhấp chuột vào đây để mở rộng...
Sao kiệm lời vậy, Chỉ đoán mò
Dữ liệu nhập xuất theo thời gian phải chuẩn, không bẩy lỗi xuất âm
Mã: 
Sub NgayDauTonKho()
  Dim aNhap(), aXuat(), Res(), SanPham$
  Dim eRow&, sRow&, i&, r&, sRow2&, i2&, iR2&, r2&, k&, tXuat#
  With Sheets("Sheet1") 'Sheet nhap
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    Res = .Range("A2:D" & eRow).Value 'Gia tri goc
    .Range("A2:D" & eRow).Sort .Range("A2"), 1, .Range("B2"), , 1, Header:=xlNo 'Sort theo San Pham va ngay
    aNhap = .Range("A2:D" & eRow).Value
    .Range("A2:D" & eRow).Value = Res 'Tra ve gia tri goc
  End With
  With Sheets("Sheet2") 'Sheet Xuat
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    Res = .Range("A2:D" & eRow).Value 'Gia tri goc
    .Range("A2:D" & eRow).Sort .Range("A2"), 1, .Range("B2"), , 1, Header:=xlNo 'Sort theo San Pham va ngay
    aXuat = .Range("A2:D" & eRow + 1).Value
    .Range("A2:D" & eRow).Value = Res 'Tra ve gia tri goc
  End With
  sRow = UBound(aXuat)
  sRow2 = UBound(aNhap)
  ReDim Res(1 To sRow2, 1 To 2)
  iR2 = 1
  For i = 1 To sRow - 1
    If aXuat(i, 1) <> SanPham Then
      SanPham = aXuat(i, 1)
      k = k + 1
      Res(k, 1) = SanPham
      For r = i To sRow
        If aXuat(r, 1) = SanPham Then
          tXuat = tXuat + aXuat(r, 3)
        Else
          For r2 = iR2 To sRow2 'Tim San Pham Nhap
            If aNhap(r2, 1) = SanPham Then
              iR2 = r2
              Exit For
            End If
          Next r2
          If r2 <= sRow2 Then 'Neu co San Pham Nhap cua San Pham Xuat
            For i2 = iR2 To sRow2
              If aNhap(i2, 1) = SanPham Then
                If tXuat > 0 Then
                  If tXuat > aNhap(i2, 3) Then
                    tXuat = tXuat - aNhap(i2, 3)
                  Else
                    Res(k, 2) = aNhap(i2, 2)
                    tXuat = 0
                  End If
                End If
              Else
                If i2 > 1 And Res(k, 2) = Empty Then 'Ton kho khong du Xuat
                  Res(k, 2) = Format(aNhap(i2 - 1, 2), "dd/mm/yyyy") & " Ton Kho Khong Du Xuat"
                End If
                iR2 = i2
                Exit For
              End If
            Next i2
            tXuat = 0:  i = r - 1:       Exit For
          End If
        End If
      Next r
    End If
  Next i
  With Sheet3
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    If eRow > 1 Then .Range("A2:B" & eRow).ClearContents
    If k Then .Range("A2:B2").Resize(k) = Res
  End With
End Sub
 
HieuCD đã viết:
Sao kiệm lời vậy, Chỉ đoán mò
Dữ liệu nhập xuất theo thời gian phải chuẩn, không bẩy lỗi xuất âm
Mã: 
Sub NgayDauTonKho()
  Dim aNhap(), aXuat(), Res(), SanPham$
  Dim eRow&, sRow&, i&, r&, sRow2&, i2&, iR2&, r2&, k&, tXuat#
  With Sheets("Sheet1") 'Sheet nhap
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    Res = .Range("A2:D" & eRow).Value 'Gia tri goc
    .Range("A2:D" & eRow).Sort .Range("A2"), 1, .Range("B2"), , 1, Header:=xlNo 'Sort theo San Pham va ngay
    aNhap = .Range("A2:D" & eRow).Value
    .Range("A2:D" & eRow).Value = Res 'Tra ve gia tri goc
  End With
  With Sheets("Sheet2") 'Sheet Xuat
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    Res = .Range("A2:D" & eRow).Value 'Gia tri goc
    .Range("A2:D" & eRow).Sort .Range("A2"), 1, .Range("B2"), , 1, Header:=xlNo 'Sort theo San Pham va ngay
    aXuat = .Range("A2:D" & eRow + 1).Value
    .Range("A2:D" & eRow).Value = Res 'Tra ve gia tri goc
  End With
  sRow = UBound(aXuat)
  sRow2 = UBound(aNhap)
  ReDim Res(1 To sRow2, 1 To 2)
  iR2 = 1
  For i = 1 To sRow - 1
    If aXuat(i, 1) <> SanPham Then
      SanPham = aXuat(i, 1)
      k = k + 1
      Res(k, 1) = SanPham
      For r = i To sRow
        If aXuat(r, 1) = SanPham Then
          tXuat = tXuat + aXuat(r, 3)
        Else
          For r2 = iR2 To sRow2 'Tim San Pham Nhap
            If aNhap(r2, 1) = SanPham Then
              iR2 = r2
              Exit For
            End If
          Next r2
          If r2 <= sRow2 Then 'Neu co San Pham Nhap cua San Pham Xuat
            For i2 = iR2 To sRow2
              If aNhap(i2, 1) = SanPham Then
                If tXuat > 0 Then
                  If tXuat > aNhap(i2, 3) Then
                    tXuat = tXuat - aNhap(i2, 3)
                  Else
                    Res(k, 2) = aNhap(i2, 2)
                    tXuat = 0
                  End If
                End If
              Else
                If i2 > 1 And Res(k, 2) = Empty Then 'Ton kho khong du Xuat
                  Res(k, 2) = Format(aNhap(i2 - 1, 2), "dd/mm/yyyy") & " Ton Kho Khong Du Xuat"
                End If
                iR2 = i2
                Exit For
              End If
            Next i2
            tXuat = 0:  i = r - 1:       Exit For
          End If
        End If
      Next r
    End If
  Next i
  With Sheet3
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    If eRow > 1 Then .Range("A2:B" & eRow).ClearContents
    If k Then .Range("A2:B2").Resize(k) = Res
  End With
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn bác. Công ty mình không có xuất > nhập nên không có xuất âm. Mình chỉ cần list ngày để tiện theo dõi ngày theo từng loại hàng hóa
 
HieuCD đã viết:
Trời ạ! Làm mình viết code loạn xà ngầu
Nhấp chuột vào đây để mở rộng...
Mà code ổn mà đúng cái mình cần. Cảm ơn cho tất cả. Mà file đó là file phụ do file excel chính công thức khá nặng. Mình chỉ muốn copy một số cột mình cần từ file chính vào file phụ. Chỉ lấy dữ liệu cho tới dòng cuối cùng và file chính ở chế độ đóng. Giúp đỡ viết code copy cột theo dạng dễ hiểu để mình tự làm thêm cột nếu cần tại mình chưa rành lắm
 

File đính kèm

  • Sổ làm việc (3).xlsx
    9.9 KB · Đọc: 8
  • Sổ làm việc (4).xlsx
    9.8 KB · Đọc: 7
Lần chỉnh sửa cuối:
Hoan1985 đã viết:
Mà code ổn mà đúng cái mình cần. Cảm ơn cho tất cả. Mà file đó là file phụ do file excel chính công thức khá nặng. Mình chỉ muốn copy một số cột mình cần từ file chính vào file phụ. Chỉ lấy dữ liệu cho tới dòng cuối cùng và file chính ở chế độ đóng. Giúp đỡ viết code copy cột theo dạng dễ hiểu để mình tự làm thêm cột nếu cần tại mình chưa rành lắm
Nhấp chuột vào đây để mở rộng...
Người ta kêu trời mà vẫn không tha.
Phần này chắc không khó, bạn nên tự làm,
Hơn nữa nó là vấn đề khác, nên mở chủ đề mới nếu cần
 
HieuCD đã viết:
Vậy là viết lại code Nhập xuất tồn
Thời gian nhập xuất không phù hợp (Xuất nhưng chưa nhập kho) giải quyết như thế nào
Nhấp chuột vào đây để mở rộng...
Chào ạ! mình có 1 file xuất nhập FIFO nhưng nó bị lỗi ở một chỗ nhưng không biết khắc phục như thế nào
Lỗi: Khi mình xuất kho vượt quá 50% giá trị tồn kho thì thành tiền nó chỉ nhận lượng xuất kho tương ứng với lượng hàng còn tồn lại trong kho.
Không biết nguyên nhân do code lỗi hay sao, rất mong được sự giúp đỡ.
Cảm ơn ạ!
screenshot_1663819397.png
 

File đính kèm

  • KHO - BÁN HÀNG.xlsm
    736.4 KB · Đọc: 10
Võ Viễn Đông đã viết:
Chào ạ! mình có 1 file xuất nhập FIFO nhưng nó bị lỗi ở một chỗ nhưng không biết khắc phục như thế nào
Lỗi: Khi mình xuất kho vượt quá 50% giá trị tồn kho thì thành tiền nó chỉ nhận lượng xuất kho tương ứng với lượng hàng còn tồn lại trong kho.
Không biết nguyên nhân do code lỗi hay sao, rất mong được sự giúp đỡ.
Cảm ơn ạ!
View attachment 281225
Nhấp chuột vào đây để mở rộng...
Code tính giá xuất kho FIFO không đúng quy định, bạn nên tính thủ công trên giấy sau đó viết code theo đúng trình tự tính thủ công
 
Làm theo mấy ông kho gà mờ nầy chắc chết. Yêu cầu lung tung, file thì úp úp mở mở, vừa viết đoạn code nầy xong thì lại kêu thêm chuyển thành đoạn code khác. Do data chưa chuẩn, file báo cáo thì mập mờ...haizzzz
Ai mà chạy theo yêu cầu thay đổi xành xạch của mấy ổng nổi.
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

LuuAnh980
Công thức thỏa mãn 2 điều kiện thì có dấu X, nếu không thì =""
Trả lời
4
Đọc
26
LuuAnh980
LuuAnh980
72G1
File và thư mục
Trả lời
4
Đọc
53
SA_DQ
SA_DQ
kyo
  • Suggestion
Bài viết: SAP Scripting – Excel và SAP (P2)
    • Thích
Trả lời
14
Đọc
8K
pic vo123
P
S
Sao excel lại biến dữ liệu thành dữ liệu nhiều các con số?
Trả lời
12
Đọc
160
syquyen1987
S
Emyeuexcel
  • Question
VBA lưu file, in, và mở lại file gốc ban đầu
Trả lời
4
Đọc
89
Hoàng Tuấn 868
H
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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