NguyenthiH
Thành viên mới đăng ký
- Tham gia
- 11/12/16
- Bài viết
- 965
- Được thích
- 175
- Giới tính
- Nữ
bạn kiểm tra lại fileChà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õ.
bạn chỉnh lại đoạn cuối của subXin lỗi Anh Hiếu.
Do máy em nó làm sao ấy. Được rồi ah. Anh chỉnh code để tự Border bảng chi tiết dùm em ah.
Dữ liệu tới đâu Border tới đó ah.
Cám Ơn Anh.
....
'Gan ket qua
Range("A6:F1000").ClearContents
Range("A6:F1000").Borders.LineStyle = xlNone
If k Then
Range("A6").Resize(k, 6) = Arr
Range("A5").Resize(k + 1, 6).Sort [B5], 1, [F5], , 2, Header:=xlYes
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
file mình không có bị, nên không biết như thế nàoVà trong VBE thì có tới 2 ThisWorkBook như hình, và code lại nằm trong Sheet4(ThisWorkBook), em có thử xóa Sheet4(ThisWorkBook) nhưng không được
Lấy file gốc của bạn và thêm code, xóa name không cần thiết. bạn tải lại file mới ở bài #8 xem saoEm xài Win10 Office2016, chỉ có File này bị như vậy thôi, còn mấy file Excel khác không bị.
Mong mọi người giúp đỡ.
bị lổi là do tạo list trong Data Validation bằng mảng. bạn kiểm tra lại file mới tự động hoàn toàn không cần nút lệnhEm có search trên Google, vào trang này(cũng hiện bang giống em), nhưng trình tiếng Anh hơi kém nên cũng chả hiểu, Anh có thể giúp em.
bạn xem file mới, đã sort list C3cám ơn Anh Hiếu, được rồi Anh ơi! Không lỗi nữa.
Ah mà Anh có thể Sort list trong Validation C3 được không Anh?
Chúc Anh một ngày VUI VẺ!
bỏ khai báo Puclic của Function SortList cũng được, phải nằm trong moduleCám Ơn Anh Hiếu đã nhiệt tình giúp đỡ.
Có phải Anh Sort list Validation bằng hàm tự tao, và khai báo Public cho vào Module1 phải không Anh?
Chỉ cần vậy thôi, chư không cài trong Sub nào hả Anh?
Em cám ơn Anh.
https://drive.google.com/open?id=0B63YPhFgbjNZcjNQaTR5TVRfZlk file nhập xuất tồn.bạn xem file mới, đã sort list C3
dùng combobox hơi rối, Validation nhẹ hơnNế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.
bạn chạy thử mới biết, tạo list rất nhẹ, chỉ sợ code Loc thôiCá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 chep code vào sheet TonXin 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.
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
bạn xem file đính kèmSAo 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.
Range("A2").Resize(k, 6).Sort [A2], 1, [B2], , 2, Header:=xlNo
mình quên vụ sort, bạn chỉnh code lại chổ màu đỏEm ngồi mò cả ngày mới ra chổ Sort cột B sheet Ton
Em sửa số 2 thành 1 thì Sort tăng dần.Mã:Range("A2").Resize(k, 6).Sort [A2], 1, [B2], , 2, Header:=xlNo
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.
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
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
dòng dữ liệu của tên phụ liệu đầu tiên là dòng thứ bao nhiêu?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.
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 đượcCũng bắt đầu từ dòng A2.
Mong Anh Hiếu giúp.
bạn mở file, code sẽ tự chạyXin 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.
Validation gỏ vào bình thường nếu đúng thì cho phép, sai thì báo lỗiCám ơn Anh Hiếu nhiều nhiều.
Đúng rồi ah!
Chúc Anh một ngày vui!
ps: có cách nào để tăng cỡ chữ trong Validation không Anh, hoặc gỏ vào Validation, nói chung là để dò cho nhanh, chứ cỡ ngàn mặt hang mà cứ kéo chuột trong Validation tìm thì lâu quá.
bạn xem file, vẫn dùng code trướcEm có sưu tầm code của Thầy ndu là tạo TextBox và Listbox để loc, xin Anh Hiếu giúp phần lọc Nhập Xuất Tồn khi chọn tên phụ liệu ở C3.