Dữ liệu thay đổi dòng cột thì code phải viết lạiAnh HieuCD ơi !
Nhờ Anh hỗ trợ dùm em 1 vấn đề này nữa, cụ thể như sau:
- Sheet PS - cột đơn giá dựa vào 2 điều kiện sẽ dò từ:
+ Sheet GIA: dựa vào 2 điều kiện mã hàng + mã nhà cũng cấp
+ Nếu không có sẽ dò Sheet XNT: dựa vào 2 điều kiện mã kiện + mã vật tư
Em cám ơn anh rất nhiều !
Sub GiaPS()
Dim i As Long, key As String
Dim Arr As Variant, dArr As Variant
With CreateObject("Scripting.Dictionary")
With Sheets("GIA")
i = .Range("A" & Rows.Count).End(xlUp).Row
If i > 1 Then
dArr = .Range("A2:E" & i).Value
For i = 1 To UBound(dArr, 1)
If dArr(i, 1) <> "" And dArr(i, 3) <> "" Then
key = dArr(i, 1) & "#" & dArr(i, 3)
.Item(key) = dArr(i, 5)
End If
Next i
End If
End With
With Sheets("XNT")
i = .Range("A" & Rows.Count).End(xlUp).Row
If i > 9 Then
dArr = .Range("A10:H" & i).Value
For i = 1 To UBound(dArr, 1)
If dArr(i, 1) <> "" And dArr(i, 2) <> "" Then
key = dArr(i, 1) & "$" & dArr(i, 2)
.Item(key) = dArr(i, 8)
End If
Next i
End If
End With
With Sheets("PS")
i = .Range("A" & Rows.Count).End(xlUp).Row
If i > 2 Then
dArr = .Range("A3:G" & i).Value
ReDim Arr(1 To UBound(dArr, 1), 1 To 1)
For i = 1 To UBound(dArr, 1)
If dArr(i, 1) <> "" And dArr(i, 7) <> "" Then
key = dArr(i, 1) & "#" & dArr(i, 7)
If .exists(key) Then Arr(i, 1) = .Item(key)
End If
If Arr(i, 1) = "" Then
If dArr(i, 6) <> "" And dArr(i, 7) <> "" Then
key = dArr(i, 6) & "$" & dArr(i, 7)
If .exists(key) Then Arr(i, 1) = .Item(key)
End If
End If
Next i
End If
If IsArray(Arr) Then .Range("M3").Resize(UBound(Arr)) = Arr
End With
End With
End Sub
Sub XNT()
Dim i As Long, k As Long, key As String
Dim Arr As Variant, dArr As Variant
With Sheets("PS")
dArr = .Range("F3", .Range("I" & Rows.Count).End(xlUp)).Value
End With
ReDim Arr(1 To UBound(dArr, 1), 1 To 4)
With CreateObject("Scripting.Dictionary")
For i = 1 To UBound(dArr, 1)
key = dArr(i, 1) & "#" & dArr(i, 2)
If Not .exists(key) Then
.Add key, ""
k = k + 1
Arr(k, 1) = dArr(i, 1): Arr(k, 2) = dArr(i, 2)
Arr(k, 3) = dArr(i, 3): Arr(k, 4) = dArr(i, 4)
End If
Next i
End With
With Sheets("XNT")
.Range("A10:D1010").EntireRow.Hidden = False
.Range("A10:D1010").ClearContents
If k Then .Range("A10:D10").Resize(k) = Arr
i = .Range("A" & Rows.Count).End(xlUp).Row
If i < 9 Then i = 9
.Range("A" & i + 1, "A1010").EntireRow.Hidden = True
End With
End Sub
Sub CN()
Dim i As Long, k As Long, key As String
Dim Arr, dArr
With Sheets("PS")
dArr = .Range("A3", .Range("B" & Rows.Count).End(xlUp)).Value
End With
ReDim Arr(1 To UBound(dArr, 1), 1 To 2)
With CreateObject("Scripting.Dictionary")
For i = 1 To UBound(dArr, 1)
key = dArr(i, 1)
If Not .exists(key) Then
.Add key, ""
k = k + 1
Arr(k, 1) = dArr(i, 1): Arr(k, 2) = dArr(i, 2)
End If
Next i
End With
With Sheets("CN")
.Range("A10:B50").EntireRow.Hidden = False
.Range("A10:B50").ClearContents
If k Then .Range("A10:B10").Resize(k) = Arr
i = .Range("A" & Rows.Count).End(xlUp).Row
If i < 9 Then i = 9
.Range("A" & i + 1, "A50").EntireRow.Hidden = True
End With
End Sub
2 with lồng nhau nó không chịu chạyAnh HieuCD xem lại giúp em với ah!
Báo lỗi chỗ dò đơn giá, nhờ anh xem lại giúp em với.
Em cám ơn nhiều !
Sub GiaPS()
Dim i As Long, key As String
Dim Dic As Object, Arr As Variant, dArr As Variant
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("GIA")
i = .Range("A" & Rows.Count).End(xlUp).Row
If i > 1 Then
dArr = .Range("A2:E" & i).Value
For i = 1 To UBound(dArr, 1)
If dArr(i, 1) <> "" And dArr(i, 3) <> "" Then
key = dArr(i, 1) & "#" & dArr(i, 3)
Dic.Item(key) = dArr(i, 5)
End If
Next i
End If
End With
With Sheets("XNT")
i = .Range("A" & Rows.Count).End(xlUp).Row
If i > 9 Then
dArr = .Range("A10:H" & i).Value
For i = 1 To UBound(dArr, 1)
If dArr(i, 1) <> "" And dArr(i, 2) <> "" Then
key = dArr(i, 1) & "$" & dArr(i, 2)
Dic.Item(key) = dArr(i, 8)
End If
Next i
End If
End With
With Sheets("PS")
i = .Range("A" & Rows.Count).End(xlUp).Row
If i > 2 Then
dArr = .Range("A3:G" & i).Value
ReDim Arr(1 To UBound(dArr, 1), 1 To 1)
For i = 1 To UBound(dArr, 1)
If dArr(i, 1) <> "" And dArr(i, 7) <> "" Then
key = dArr(i, 1) & "#" & dArr(i, 7)
If Dic.exists(key) Then Arr(i, 1) = Dic.Item(key)
End If
If Arr(i, 1) = "" Then
If dArr(i, 6) <> "" And dArr(i, 7) <> "" Then
key = dArr(i, 6) & "$" & dArr(i, 7)
If Dic.exists(key) Then Arr(i, 1) = Dic.Item(key)
End If
End If
Next i
End If
If IsArray(Arr) Then .Range("M3").Resize(UBound(Arr)) = Arr
End With
End Sub
Cấu trúc và trình tự vận hành file của bạn như thế nào mình không biết rỏ nên phải viết code chung chungAnh HieuCD ơi !
Em nghĩ như thế này anh xem có khả thi hơn không nha, excel thì làm được nhưng sẽ làm file chậm.
- Nếu là PN cột C2 trở đi ở sheet thì làm quét giá ở sheet giá (như cách trên).
- Nếu là PX thì dò tìm bên sheet XNT các trường như trên.
Ngoài ra, cho em hỏi mình có cần sắp xếp lại data không anh nhỉ?
Em cám ơn anh nhiều !
Cấu trúc và trình tự vận hành file của bạn như thế nào mình không biết rỏ nên phải viết code chung chung
- Sheet PS cột C có gì để nhận biết nhập xuất
- Sheet GIA và NXT các dòng dữ liệu có khi nào 1 loại mà có 2 giá (đặc biệt sheet GIA)
Dữ liệu không cần sắp xếp
File bạn gởi không có gì để biết nhập hay xuấtCách của anh viết người ngu như em cũng có thể thay đổi, rất dễ hiểu.
Như thế này nè anh.
PN là mình mua hàng sẽ lấy hoàn đơn giá từ Sheet GIA
PX là mình lấy từ sheet NXT là đơn giá bình quân gia quyền theo tháng.
(VD: Ngày 1 mua 10L giá 20k, ngày 17 mua 5L giá 10k, bình quân là 2k/L)
Ngoài ra, còn có cách tính theo FIFO là nhập trước xuất trước thì đòi hỏi cao hơn,
sẽ khó hơn, đòi hỏi sắp xếp dữ liệu theo thứ tự lấy dữ liệu từ trên xuống - em không chọn cách này.
Vì có người nói là không biết cách sắp xếp dữ liệu, không chỉ là phải sắp xếp như thế nào là cho đúng?
Sheet PS là sheet để nhập liệu, chủ yếu là phiếu nhập và phiếu xuất thôi.
Các sheet khác sẽ lấy dữ liệu từ đây qua, XNT, Công nợ, in Phiếu nhập, in Phiếu xuất... liên quan đến KHO.
Rất mong được sự giúp đỡ của anh rất nhiều !
Chạy codeEm gửi Anh File đây ah !
File 1.000 dòng hơi chậm, thực tế khoảng 2.000 dòng ở sheet phát sinh, cứ lặp đi lặp lại thôi ah.
Em tìm cách cải thiện file, hơi chậm mà VBA em gần như chưa biết gì hết.
Thấy anh nhiệt tình giúp em, em cám ơn thật nhiều !
Sub GiaPS()
Dim i As Long, key As String
Dim Dic As Object, Arr As Variant, dArr As Variant
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("GIA")
i = .Range("A" & Rows.Count).End(xlUp).Row
If i > 1 Then
dArr = .Range("A2:E" & i).Value
For i = 1 To UBound(dArr, 1)
If dArr(i, 1) <> "" And dArr(i, 3) <> "" Then
key = dArr(i, 1) & "#" & dArr(i, 3)
Dic.Item(key) = dArr(i, 5)
End If
Next i
End If
End With
With Sheets("XNT")
i = .Range("A" & Rows.Count).End(xlUp).Row
If i > 9 Then
dArr = .Range("A10:H" & i).Value
For i = 1 To UBound(dArr, 1)
If dArr(i, 1) <> "" And dArr(i, 2) <> "" Then
key = dArr(i, 1) & "$" & dArr(i, 2)
Dic.Item(key) = dArr(i, 8)
End If
Next i
End If
End With
With Sheets("PS")
i = .Range("A" & Rows.Count).End(xlUp).Row
If i > 2 Then
dArr = .Range("A3:G" & i).Value
ReDim Arr(1 To UBound(dArr, 1), 1 To 1)
For i = 1 To UBound(dArr, 1)
If dArr(i, 3) <> "PN" Then
If dArr(i, 1) <> "" And dArr(i, 7) <> "" Then
key = dArr(i, 1) & "#" & dArr(i, 7)
If Dic.exists(key) Then Arr(i, 1) = Dic.Item(key)
End If
ElseIf dArr(i, 6) <> "" And dArr(i, 7) <> "" Then
key = dArr(i, 6) & "$" & dArr(i, 7)
If Dic.exists(key) Then Arr(i, 1) = Dic.Item(key)
End If
Next i
End If
If IsArray(Arr) Then .Range("M3").Resize(UBound(Arr)) = Arr
End With
End Sub
Em chào Anh HieuCD ah !
Em mới bắt đầu tập tành học code VBA để hỗ trợ công việc tốt hơn.
Em làm phiền anh nhiều quá thì sẽ không hay.
Chỉ dám mong anh hỗ trợ giúp em cải tiến file này bằng VBA, cái này đối với e hiện tại là cần thiết nhất.
Hàm excel cũng đã chèn vào 1 số sheet tương đối hoàn thiện
- Sheet XNT
- Sheet CN
- Sheet PN
- Sheet PX
- Sheet PNX
- Sheet NXT là của kê thuế cũng giống như Sheet XNT
nhưng ở đây chỉ có ít trường hơn
+ Mã hàng - tên hàng - đvt
+ Tồn đầu kỳ
+ Số lượng nhập căn cứ vào loại PN (không có trường nhập khác)
+ Số lượng nhập căn cứ vào loại PX (không có trường xuất khác)
Ngoài ra, còn 3 sheet còn lại, em đang nghĩ dùng công thức để thiết lập trước bằng excel, các trường phù hợp.
Em chỉ biết cám ơn anh đã giúp đỡ em rất nhiều !
File nầy vướng cách tính giá nên không thể làm gì tiếpEm chào Anh HieuCD ah !
Em mới bắt đầu tập tành học code VBA để hỗ trợ công việc tốt hơn.
Em làm phiền anh nhiều quá thì sẽ không hay.
Chỉ dám mong anh hỗ trợ giúp em cải tiến file này bằng VBA, cái này đối với e hiện tại là cần thiết nhất.
Hàm excel cũng đã chèn vào 1 số sheet tương đối hoàn thiện
- Sheet XNT
- Sheet CN
- Sheet PN
- Sheet PX
- Sheet PNX
- Sheet NXT là của kê thuế cũng giống như Sheet XNT
nhưng ở đây chỉ có ít trường hơn
+ Mã hàng - tên hàng - đvt
+ Tồn đầu kỳ
+ Số lượng nhập căn cứ vào loại PN (không có trường nhập khác)
+ Số lượng nhập căn cứ vào loại PX (không có trường xuất khác)
Ngoài ra, còn 3 sheet còn lại, em đang nghĩ dùng công thức để thiết lập trước bằng excel, các trường phù hợp.
Em chỉ biết cám ơn anh đã giúp đỡ em rất nhiều !
Góp ý. Chỉ nói về cách làm -> không nói về Code VBA trong file.
1. Công thức không tham chiếu cả cột khi viết công thức, ví dụ như : =SUMIFS(PS!M:M,PS!C:C,"KETCHUYEN",PS!H:H,A10,PS!I:I,B10)
2. Đã làm File NXT thì phải làm bài bản, bài bản ở đây có nghĩa là:
+ Nhập liệu được: nhập liệu 1 cách khoa học...
---> Chưa nói việc bạn nhập giá trong sheet nhập liệu của bạn. Mai này đổi giá thì sao??? Đè lại giá cũ ah? Nhập liệu kiểu vậy ---> đi ăn mày sớm!
+ Theo dõi được chi tiết, tổng hợp.
+ Theo dõi phải từ ngày tới ngày -> Tự động tính lại số dư đầu kỳ, cuối kỳ trong khoản thời gian...
3. Nhiều thứ lắm....
File bạn chưa đáp ứng được mấy cái cơ bản trên -> chưa gọi là hoàn thiện được.
1/ Sheet PS bạn nhập tay hay lấy từ phần mềm? và gồm có dữ liệu cột nào? cột nào để trốngEm cám ơn 2 anh đã quan tâm hỗ trợ!
Nó là như thế này:
- Sheet PS là sheet nhập liệu chung hết
+ Đơn giá sẽ lấy từ Sheet NCC điền vào loại phiếu PN (mã nhà cung cấp + mã hàng)
+ Đơn giá xuất lấy từ Sheet NXT điền vào phiếu PX (căn cứ vào mã kiện + mã hàng)
Đơn giá xuất chỉ kho có đơn giá nhập mới có đơn giá để xuất.
. Click sự kiện 1 lấy đơn giá nhập điền vào phiếu PN Sheet PS
. Click sự kiện 2 Sheet NXT sẽ có đơn giá bình quân
. Click sự kiện 3 để lấy đơn giá vào phiếu PX ở Sheet PS
Nếu được thì có thể gộp lại chung vào 1 sự kiện thì quá tốt.
Ngoài ra, nếu chưa có giá thì mình để trống hoặc bằng 0, sẽ kiểm tra lại chỗ đó
Hôm trước anh HieuCD làm dùm em lọc mã trùng ở Sheet XNT và ẩn dòng trống,
có những nhiều dòng hay ít, mà cứ để công thức nhiều sẽ gây ảnh hưởng đến File.
- Sheet XNT được tính như sau:
+ Tồn đầu kỳ
Dựa vào Mã CC mặc định là KETCHUYEN, kết hợp với Mã Kiện và Mã Hàng từ tháng trước mang sang nhập ở Sheet PS luôn.
+ Nhập kho
Căn cứ vào Sheet PS để tính dựa các trường PN kết hợp Mã Kiện + Mã Hàng
+ Nhập khác
Căn cứ vào Sheet PS để tính dựa các trường NK kết hợp Mã Kiện + Mã Hàng
+ Xuất kho
Căn cứ vào Sheet PS để tính dựa các trường PX kết hợp Mã Kiện + Mã Hàng
+ Nhập khác
Căn cứ vào Sheet PS để tính dựa các trường XK kết hợp Mã Kiện + Mã Hàng
+ Tồn cuối kỳ
= Tồn đầu + nhập kho + nhập khác - xuất kho - xuất khác
+ Đơn giá bình quân (nếu linh động được thì tuyệt thời - giống cách viết của anh HieuCD)
Đối với kho gỗ hoặc MDF
= (TT tồn đầu kỳ + TT nhập kho + TT nhập khác)/(M3 tồn đầu kỳ + M3 nhập kho + M3 nhập khác)
Ngoài ra đối với các kho khác
= (TT tồn đầu kỳ + TT nhập kho + TT nhập khác)/(THANH tồn đầu kỳ + THANH nhập kho + THANH nhập khác)
Anh có cách nào hay hơn thì chỉ giúp em, em cám ơn các anh rất nhiều !
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2