bảng kê chi tiết nhập xuất (1 người xem)

[NguyenthiH]

Chào các AC!
Em có file Excel nhờ các Anh Chị giúp đỡ, khi chọn trong 2 validation ở sheet "ChiTiet" thì hiện ra chi tiết nhập - xuất- tồn của phụ lieu đó.
Trong file em có ghi rõ.

 

[HieuCD]

Nếu bây giờ mình không dùng Validation (Tránh lỗi) thì có thể dùng ComboBox được không Anh?
File của Anh, nếu em Save As qua xlsb thì lại bị lỗi.

dùng combobox hơi rối, Validation nhẹ hơn
dùng cột I và J của sheet Chitiet để lưu List cho ổn định
mở Validation của từng ô để xem công thức trong đó
kiểm tra các sheet trong VBA để xem code

 

[NguyenthiH]

Cám Ơn Anh Hiếu, nhưng em sợ dữ liệu lên cả chục nghìn dòng thì có bị đơ không Anh?
Và khi có phụ liệu mới thì copy vào cột I của sheet"Chitiet" và lại Sort lại hả Anh?
Cám ơn sự nhiệt tình của Anh!

 

[HieuCD]

Cám Ơn Anh Hiếu, nhưng em sợ dữ liệu lên cả chục nghìn dòng thì có bị đơ không Anh?
Và khi có phụ liệu mới thì copy vào cột I của sheet"Chitiet" và lại Sort lại hả Anh?
Cám ơn sự nhiệt tình của Anh!

bạn chạy thử mới biết, tạo list rất nhẹ, chỉ sợ code Loc thôi
các list tự động chạy, khi bạn chọn sheet tồn và thoát khỏi sheet Ton thì danh sách sẽ tự tạo lại

 

[NguyenthiH]

Ah giờ em mới để ý Sub CreatListPL() và Sub CreatDH() trong Module1.
Cám ơn Anh.
Để em thử cỡ ngàn dòng xem sao.

 

[NguyenthiH]

Xin Anh Hiếu giúp em thêm code để khi em activate sheet"Ton" thì tự nạp 3 cột A,B,C của sheet "Nhap" vào cột A,B,C của sheet "Ton" (lấy không trùng và Sort theo cột A sheet"Ton"
Em Cám ơn. Vì khi em nhập them phụ lieu ở sheet "Nhap" thi nó tự nạp không trùng qua sheet"Ton" để tính tồn.

 

[NguyenthiH]

Em xin lỗi, lấy cột BCD của sheet"Nhap" vào cột ABC của sheet"Ton".

 

[HieuCD]

Xin Anh Hiếu giúp em thêm code để khi em activate sheet"Ton" thì tự nạp 3 cột A,B,C của sheet "Nhap" vào cột A,B,C của sheet "Ton" (lấy không trùng và Sort theo cột A sheet"Ton"
Em Cám ơn. Vì khi em nhập them phụ lieu ở sheet "Nhap" thi nó tự nạp không trùng qua sheet"Ton" để tính tồn.

bạn chep code vào sheet Ton

Private Sub Worksheet_Activate()
  Dim Darr(), Arr(), Dic As Object, Tmp As String, i As Long, k As Long, LastN As Long, LastX As Long
  LastN = Sheets("Nhap").Range("B65500").End(xlUp).Row
  LastX = Sheets("Xuat").Range("B65500").End(xlUp).Row
  If LastN > 1 Then
    Darr = Sheets("Nhap").Range("B2:E" & LastN).Value
    ReDim Arr(1 To LastN + LastX - 2, 1 To 6)
    Set Dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(Darr)
      Tmp = Darr(i, 1) & "#" & Darr(i, 2)
      If Not Dic.exists(Tmp) Then
        k = k + 1
        Dic.Add Tmp, k
        Arr(k, 1) = Darr(i, 1)
        Arr(k, 2) = Darr(i, 2)
        Arr(k, 3) = Darr(i, 3)
      End If
      Arr(Dic.Item(Tmp), 4) = Arr(Dic.Item(Tmp), 4) + Darr(i, 4)
    Next
    If LastX > 1 Then
      Darr = Sheets("Xuat").Range("B2:F" & LastX).Value
      For i = 1 To UBound(Darr)
        Tmp = Darr(i, 1) & "#" & Darr(i, 2)
        If Dic.exists(Tmp) Then
          Arr(Dic.Item(Tmp), 5) = Arr(Dic.Item(Tmp), 5) + Darr(i, 5)
        End If
      Next i
    End If
    For i = 1 To k
      Arr(i, 6) = Arr(i, 4) - Arr(i, 5)
    Next i
    LastN = Range("A65500").End(xlUp).Row
    Application.ScreenUpdating = False
    If LastN > 1 Then
      Range("A2:F" & LastN).ClearContents
      Range("A2:F" & LastN).Borders.LineStyle = xlNone
    End If
    If k > 0 Then
      Range("A2").Resize(k, 6) = Arr
      Range("A2").Resize(k, 6).Borders.LineStyle = 1
      Range("D2").Resize(k, 3).NumberFormat = "#,##0.00_);[Red](#,##0.00)"
      Range("A2").Resize(k, 6).Sort [A2], 1, [B2], , 2, Header:=xlNo
    End If
    Application.ScreenUpdating = True
  End If
  Set Dic = Nothing
End Sub

 

[NguyenthiH]

SAo em chép code vào sheet Ton thì không thấy gì mà sheet chitiet lại được nạp vào.Mong Anh xem giúp.

 

[HieuCD]

SAo em chép code vào sheet Ton thì không thấy gì mà sheet chitiet lại được nạp vào.Mong Anh xem giúp.

bạn xem file đính kèm

 

[NguyenthiH]

Cám ơn Anh!
Hồi nãy em chép lộn, em có vào sửa bài viết,mà nhấn nút Lưu không ăn.
Em cám ơn Anh.

 

[NguyenthiH]

Ah Anh Hiếu Ơi, trong code của Anh, khi không có Xuất thì cột xuất là trống, vậy Anh có thể chỉnh cho nó là 0.00 được không Anh?

 

[NguyenthiH]

Anh Hiếu sao em thấy hình như Sort trong sheet Ton kỳ kỳ, như cột A là từ nhỏ đến lớn, nhưng cột B là từ lớn đến nhỏ, Anh coi có phải không Anh.

 

[NguyenthiH]

Em ngồi mò cả ngày mới ra chổ Sort cột B sheet Ton

Range("A2").Resize(k, 6).Sort [A2], 1, [B2], , 2, Header:=xlNo

Em sửa số 2 thành 1 thì Sort tăng dần.
Còn chổ chỉnh code để không xuất thì có số"0.00" trong cột xuất (của anh là rỗng)
Và em thử test nếu nhập và xuất trùng ngày thì Anh ưu tiên cho nhập trước xuất sau ah.

 

[HieuCD]

Em ngồi mò cả ngày mới ra chổ Sort cột B sheet Ton

Range("A2").Resize(k, 6).Sort [A2], 1, [B2], , 2, Header:=xlNo

Em sửa số 2 thành 1 thì Sort tăng dần.
Còn chổ chỉnh code để không xuất thì có số"0.00" trong cột xuất (của anh là rỗng)
Và em thử test nếu nhập và xuất trùng ngày thì Anh ưu tiên cho nhập trước xuất sau ah.

mình quên vụ sort, bạn chỉnh code lại chổ màu đỏ

Private Sub Worksheet_Activate()
  Dim Darr(), Arr(), Dic As Object, Tmp As String, i As Long, k As Long, LastN As Long, LastX As Long
  LastN = Sheets("Nhap").Range("B65500").End(xlUp).Row
  LastX = Sheets("Xuat").Range("B65500").End(xlUp).Row
  If LastN > 1 Then
    Darr = Sheets("Nhap").Range("B2:E" & LastN).Value
    ReDim Arr(1 To LastN + LastX - 2, 1 To 6)
    Set Dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(Darr)
      Tmp = Darr(i, 1) & "#" & Darr(i, 2)
      If Not Dic.exists(Tmp) Then
        k = k + 1
        Dic.Add Tmp, k
        Arr(k, 1) = Darr(i, 1)
        Arr(k, 2) = Darr(i, 2)
        Arr(k, 3) = Darr(i, 3)
[COLOR=#ff0000]        Arr(k, 4) = 0:  Arr(k, 5) = 0[/COLOR]
      End If
      Arr(Dic.Item(Tmp), 4) = Arr(Dic.Item(Tmp), 4) + Darr(i, 4)
    Next
    If LastX > 1 Then
      Darr = Sheets("Xuat").Range("B2:F" & LastX).Value
      For i = 1 To UBound(Darr)
        Tmp = Darr(i, 1) & "#" & Darr(i, 2)
        If Dic.exists(Tmp) Then
          Arr(Dic.Item(Tmp), 5) = Arr(Dic.Item(Tmp), 5) + Darr(i, 5)
        End If
      Next i
    End If
    For i = 1 To k
      Arr(i, 6) = Arr(i, 4) - Arr(i, 5)
    Next i
    LastN = Range("A65500").End(xlUp).Row
    Application.ScreenUpdating = False
    If LastN > 1 Then
      Range("A2:F" & LastN).ClearContents
      Range("A2:F" & LastN).Borders.LineStyle = xlNone
    End If
    If k > 0 Then
      Range("A2").Resize(k, 6) = Arr
      Range("A2").Resize(k, 6).Borders.LineStyle = 1
      Range("D2").Resize(k, 3).NumberFormat = "#,##0.00_);[Red](#,##0.00)"
[COLOR=#ff0000]      Range("A2").Resize(k, 6).Sort [A2], 1, [B2], , 1, Header:=xlNo[/COLOR]
    End If
    Application.ScreenUpdating = True
  End If
  Set Dic = Nothing
End Sub

sheet tồn tổng hợp trong một kỳ, nên không có thứ tự thời gian, bạn chỉnh lại sub LOC để xếp nhập trước xuất sau của sheet chi tiết

Sub Loc()
Dim Darr(), Arr(1 To 1000, 1 To 6), PL As String, DH As String, Nhap As String, LastR As Long
PL = Range("C3").Value: DH = Replace(Range("E3").Value, ";", ","): Nhap = Range("D5").Value
'Trich du lieu Nhap
LastR = Sheets("Nhap").Range("A65500").End(xlUp).Row
If LastR > 1 Then
  Darr = Sheets("Nhap").Range("A2:E" & LastR).Value
  For i = 1 To UBound(Darr)
    If DH = Darr(i, 2) And PL = Darr(i, 3) Then
      k = k + 1
      Arr(k, 2) = Darr(i, 1): Arr(k, 3) = Nhap
      Arr(k, 4) = Darr(i, 5): Arr(k, 6) = 1
    End If
  Next i
End If
'Trich du lieu Xuat
LastR = Sheets("Xuat").Range("A65500").End(xlUp).Row
If LastR > 1 Then
  Darr = Sheets("Xuat").Range("A2:F" & LastR).Value
  For i = 1 To UBound(Darr)
    If DH = Darr(i, 2) And PL = Darr(i, 3) Then
      k = k + 1
      Arr(k, 2) = Darr(i, 1): Arr(k, 3) = Darr(i, 5)
      Arr(k, 5) = Darr(i, 6): Arr(k, 6) = 2
    End If
  Next i
End If
'Gan ket qua
Range("A6:F1000").ClearContents
Range("A6:F1000").Borders.LineStyle = xlNone
If k Then
  Range("A6").Resize(k, 6) = Arr
[COLOR=#ff0000]  Range("A5").Resize(k + 1, 6).Sort [B5], 1, [D5], , 2, Header:=xlYes[/COLOR]
  Darr = Range("A6").Resize(k, 6).Value
  Darr(1, 1) = 1:  Darr(1, 6) = Darr(1, 4) - Darr(1, 5)
  For i = 2 To k
    Darr(i, 1) = i:  Darr(i, 6) = Darr(i - 1, 6) + Darr(i, 4) - Darr(i, 5)
  Next i
  Range("A6").Resize(k, 6) = Darr
  Range("A6").Resize(k, 6).Borders.LineStyle = 1
  Range("D6").Resize(k, 3).NumberFormat = "#,##0.00_);[Red]($#,##0.00)"
End If
End Sub

 

[NguyenthiH]

Đúng rồi Anh Hiếu Ơi.
Cám Ơn Anh Hiếu nhiều nhiều!

 

[NguyenthiH]

Chào Anh Hiếu!
Bây giờ em có thêm Sheet TonDau, và cột A là "Ten Phu Lieu" cột B là "ĐVT", Cột C là "SL Ton Dau"
Mong Anh chỉnh code trong sheet Ton và Sheet Chitiet dùm.
Cột Ton trogn sheet Ton lúc này sẽ là = Tondau + Nhap - Xuat, Cot Ton trong Sheet Chitiet cũng vậy.
Mong Anh giúp.

 

[HieuCD]

Chào Anh Hiếu!
Bây giờ em có thêm Sheet TonDau, và cột A là "Ten Phu Lieu" cột B là "ĐVT", Cột C là "SL Ton Dau"
Mong Anh chỉnh code trong sheet Ton và Sheet Chitiet dùm.
Cột Ton trogn sheet Ton lúc này sẽ là = Tondau + Nhap - Xuat, Cot Ton trong Sheet Chitiet cũng vậy.
Mong Anh giúp.

dòng dữ liệu của tên phụ liệu đầu tiên là dòng thứ bao nhiêu?

 

[NguyenthiH]

Cũng bắt đầu từ dòng A2.
Mong Anh Hiếu giúp.

 

[HieuCD]

Cũng bắt đầu từ dòng A2.
Mong Anh Hiếu giúp.

một loại NPL dùng cho nhiều đơn hàng khác nhau, và code trước trong sheet TON mỗi loại NPL có thể nằm trong nhiều dòng, như vậy không thể tính đúng chuẩn số tồn thực tế cho từng dòng của sheet Ton được
ví dụ: NPL A tồn đầu 200
đơn hàng 1: nhập 400 xuất 320
đơn hàng 2: nhập 350 xuất 230
vậy ở 2 dòng đơn hàng tính cột Tồn như thế nào đây?

 

[NguyenthiH]

Xin lỗi Anh Hiếu, em gửi file mới nhờ Anh giúp đỡ.
Trong file, ở sheet Ton thì cũng giống như File cũ(Kha_Dongphuc)
Ở Sheet ChiTiet thì khi chọn tên phụ liệu trong validation cell C3, thì sẽ hiện chi tiết nhập xuất tồn của phụ liệu đó. và cell E3 sẽ thể hiện Số lượng tồn đầu của phụ liệu đó.
Em Cám Ơn Anh.