Ghi lại các mã nguyên phụ liệu bị âm

Nhật Anh 9x · 13/3/23

Chào anh chị

Em có một vấn đề như thế này cần các anh chị giúp đỡ ạ!
Em có một thẻ kho để kiểm tra tồn có bị âm không, Em chạy vòng lặp, lặp qua từng mã NPL, trong quá trình chạy em muốn khi phát hiện ra một mã
NPL nào đó tồn bị âm sẽ được khi lại, và khi chạy xong sẽ hiện ra một thông báo ví dụ như :" BẠN CÓ 5 mã NPL bị âm thời điểm là những mã NPL03 , NPL05, NPL06, NPL08,NPL20". Hiện tại code em đã chạy được dữ liệu cho từng mã NPL chỉ còn ghi những mã âm, và hiển thị thông báo như ví dụ là em chưa làm được ạ
Vậy anh chị nào đã gặp trường hợp này hoặc biết thì xin chỉ dạy cho em với ạ

Sub test3()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim wb As Workbook
Set wb = ThisWorkbook
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
Dim lr1 As Long, lr3 As Long
Dim i As Long, j As Long, z As Long, k As Long
Dim coll As Collection
Set coll = New Collection
Dim arr_N As Variant
Dim arr_D As Variant

Dim t
t = Timer()
Set sh1 = wb.Worksheets("Nhap-Xuat")
Set sh2 = wb.Worksheets("Thekho")
Set sh3 = wb.Worksheets("MANPL")
lr1 = sh1.Range("D" & Rows.Count).End(xlUp).Row
lr3 = sh3.Range("B" & Rows.Count).End(xlUp).Row

'lặp qua từng mã NPL trong sheet MANPL
For z = 2 To lr3
sh2.Range("F7") = sh3.Range("B" & z).Value
arr_N = sh1.Range("A12:U" & lr1).Value
tdk = sh2.Range("J14").Value
ReDim arr_D(1 To UBound(arr_N, 1), 1 To 10)
j = 0
For i = 1 To UBound(arr_N, 1)
If arr_N(i, 15) <> "" And arr_N(i, 15) = sh2.Range("F7") Then
j = j + 1
On Error Resume Next
coll.Add j, arr_N(i, 15)
If arr_N(i, 2) = "N" Then
arr_D(j, 1) = arr_N(i, 1) 'so phieu
arr_D(j, 2) = arr_N(i, 7) 'ngay phieu
arr_D(j, 3) = arr_N(i, 6) 'dien giai
arr_D(j, 6) = arr_N(i, 18) 'so luong nhap
arr_D(j, 8) = 0 'so luong xuat

ElseIf arr_N(i, 2) = "XS" Or arr_N(i, 2) = "XT" Then
coll.Add j, arr_N(i, 15)
arr_D(j, 1) = arr_N(i, 1) 'so phieu
arr_D(j, 2) = arr_N(i, 7) 'ngay phieu
arr_D(j, 3) = arr_N(i, 6) 'dien giai
arr_D(j, 6) = 0 'so luong nhap
arr_D(j, 8) = arr_N(i, 21) 'so luong nhap

End If
On Error GoTo 0
End If

Next i

If j > 0 Then
sh2.Range("A14:L2556").AutoFilter
sh2.Range("A15").Resize(2541, 10).ClearContents
sh2.Range("A15").Resize(j, 10) = arr_D
End If

'tính giá trị cho cột tồn cuối kỳ
For i = 15 To j + 14
sh2.Range("J" & i).Value = sh2.Range("J" & i - 1) + sh2.Range("F" & i) - sh2.Range("H" & i)

'Khu vực muốn ghi những mã nguyên phụ liệu có âm thời điểm ở cột tồn cuối kỳ

Next i

sh2.Range("A14:L2556").Select
Selection.AutoFilter
ActiveSheet.Range("A14:L2556").AutoFilter Field:=10, Criteria1:="<>"

Next z

'Kết quả trả về sau khi lặp qua tất cả các mã nguyên phụ liệu

Application.ScreenUpdating = True
Application.DisplayAlerts = True

MsgBox Timer() - t
End Sub

Maika8008 · 13/3/23

Nhìn cái bài đăng chán liền. Một rừng code dán thẳng lên trang, không file kèm.

Nhật Anh 9x · 13/3/23

Maika8008 đã viết:
Nhìn cái bài đăng chán liền. Một rừng code dán thẳng lên trang, không file kèm.

em copy code vào lúc đính kèm thì nó có thứ tự thụt vào, nhưng k hiểu sao đăng bài xong thì lại như vậy. em chưa có kinh nghiệm, mong anh thông cảm. còn file tối em đính kèm ạ. nãy em quên mất

Maika8008 · 13/3/23

Copy code vào trong khung dành cho code ấy -> Bấm vào công cụ này

rồi dán vào

Nhật Anh 9x · 13/3/23

Maika8008 đã viết:
Copy code vào trong khung dành cho code ấy -> Bấm vào công cụ này View attachment 287554 rồi dán vào

Anh ơi em gửi file đính kèm ạ, anh xem giúp em với anh nhé!
Em cảm ơn ạ!

ptm0412 · 14/3/23

Ra thông báo làm gì khi đã có danh sách âm hiện ra trên sheet. Thông báo nhấn OK rồi sẽ biến mất, danh sách trên sheet mới trường tồn.

Nhật Anh 9x · 14/3/23

ptm0412 đã viết:
Ra thông báo làm gì khi đã có danh sách âm hiện ra trên sheet. Thông báo nhấn OK rồi sẽ biến mất, danh sách trên sheet mới trường tồn.

em hiểu ý của anh là sẽ in ra danh sách các mã âm ở một chỗ nào đó , chứ nếu chỉ hiện thông báo khi mình ấn là sẽ mất đi đúng không ạ. nhưng vấn đề là em đang chưa làm được là ghi các mã NPL bị âm đó lại vào dic hoặc coll hoặc cách nào đó anh ạ, anh biết thì chỉ dạy em với ạ

ptm0412 · 14/3/23

satoshi99 đã viết:
em hiểu ý của anh là sẽ in ra danh sách các mã âm ở một chỗ nào đó , chứ nếu chỉ hiện thông báo khi mình ấn là sẽ mất đi đúng không ạ. nhưng vấn đề là em đang chưa làm được là ghi các mã NPL bị âm đó lại vào dic hoặc coll hoặc cách nào đó anh ạ, anh biết thì chỉ dạy em với ạ

Bạn đã từng làm rồi đó, Autofilter số âm, copy ra chỗ mới

Nhật Anh 9x · 14/3/23

ptm0412 đã viết:
Bạn đã từng làm rồi đó, Autofilter số âm, copy ra chỗ mới

ý em ở đây là muốn ghi được cái mã npl mà trong cột tồn có giá trị âm anh ạ, ví dụ chạy đến mã npl này mà phát hiện có âm thì ghi nó lại vào một tập hợp sau khi chạy hết tất cả các mã npl thì sẽ in ra các mã đã phát hiện có giá trị âm

bebo021999 · 14/3/23

Cách của bạn làm rất là tốn tài nguyên: Duyệt qua từng mã NVL, in ra sheet the kho, rồi lại tiếp tục qua mã khác...chỉ nhằm mục đích kiểm tra số âm?
Vậy cái sheet thẻ kho của bạn muốn in ra chi tiết của 1 NVL nào đó thì làm thế nào?
Phương án của mình thế này: code có 2 phần

Phần 1: kiểm tra số âm: sub này dành cho button "ktra âm TD2"
Code này đặt trong general module

PHP:

Option Explicit
Sub test_Am()
Dim lr&, i&, NX, dic As Object, Am As Object
Set dic = CreateObject("Scripting.Dictionary")
Set Am = CreateObject("Scripting.Dictionary")
With Sheets("Nhap-Xuat")
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
    NX = .Range("A10:U" & lr).Value
    For i = 1 To UBound(NX)
        If Not dic.exists(NX(i, 15)) Then
            dic.Add NX(i, 15), NX(i, 18) - NX(i, 21)
        Else
            dic(NX(i, 15)) = dic(NX(i, 15)) + NX(i, 18) - NX(i, 21)
            If dic(NX(i, 15)) < 0 And Not Am.exists(NX(i, 15)) Then Am.Add NX(i, 15), ""
        End If
    Next
End With
MsgBox "Ban co " & Am.Count & " ma am thoi diem la: " & Join(Am.keys, ", ")
End Sub

Phần 2: In thẻ kho. Tại sheet thekho, nhập mã vô F7 sẽ tự động in thẻ kho của mã đó.
Code đặt trong sheet module nhé.

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) <> "F7" Then Exit Sub
Dim lr&, i&, k&, ton, NX, dic As Object, res(1 To 100000, 1 To 10)
Set dic = CreateObject("Scripting.Dictionary")
With Sheets("Nhap-Xuat")
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
    NX = .Range("A10:U" & lr).Value
End With
For i = 1 To UBound(NX)
    If NX(i, 15) = Target Then
        ton = ton + NX(i, 18) - NX(i, 21): k = k + 1
        res(k, 1) = NX(i, 1): res(k, 2) = NX(i, 7): res(k, 3) = NX(i, 6)
        res(k, 6) = NX(i, 18): res(k, 8) = NX(i, 21): res(k, 10) = ton
    End If
Next
If k > 0 Then Range("A15").Resize(k, 10).Value = res
End Sub

ptm0412 · 14/3/23

satoshi99 đã viết:
ý em ở đây là muốn ghi được cái mã npl mà trong cột tồn có giá trị âm anh ạ, ví dụ chạy đến mã npl này mà phát hiện có âm thì ghi nó lại vào một tập hợp sau khi chạy hết tất cả các mã npl thì sẽ in ra các mã đã phát hiện có giá trị âm

Thế autofilter số âm không ra mã "npl" à?

Nhật Anh 9x · 14/3/23

bebo021999 đã viết:
Cách của bạn làm rất là tốn tài nguyên: Duyệt qua từng mã NVL, in ra sheet the kho, rồi lại tiếp tục qua mã khác...chỉ nhằm mục đích kiểm tra số âm?
Vậy cái sheet thẻ kho của bạn muốn in ra chi tiết của 1 NVL nào đó thì làm thế nào?
Phương án của mình thế này: code có 2 phần

Phần 1: kiểm tra số âm: sub này dành cho button "ktra âm TD2"
Code này đặt trong general module

PHP:

Option Explicit Sub test_Am() Dim lr&, i&, NX, dic As Object, Am As Object Set dic = CreateObject("Scripting.Dictionary") Set Am = CreateObject("Scripting.Dictionary") With Sheets("Nhap-Xuat") lr = .Cells(Rows.Count, "A").End(xlUp).Row NX = .Range("A10:U" & lr).Value For i = 1 To UBound(NX) If Not dic.exists(NX(i, 15)) Then dic.Add NX(i, 15), NX(i, 18) - NX(i, 21) Else dic(NX(i, 15)) = dic(NX(i, 15)) + NX(i, 18) - NX(i, 21) If dic(NX(i, 15)) < 0 And Not Am.exists(NX(i, 15)) Then Am.Add NX(i, 15), "" End If Next End With MsgBox "Ban co " & Am.Count & " ma am thoi diem la: " & Join(Am.keys, ", ") End Sub

Phần 2: In thẻ kho. Tại sheet thekho, nhập mã vô F7 sẽ tự động in thẻ kho của mã đó.
Code đặt trong sheet module nhé.

PHP:

Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address(0, 0) <> "F7" Then Exit Sub Dim lr&, i&, k&, ton, NX, dic As Object, res(1 To 100000, 1 To 10) Set dic = CreateObject("Scripting.Dictionary") With Sheets("Nhap-Xuat") lr = .Cells(Rows.Count, "A").End(xlUp).Row NX = .Range("A10:U" & lr).Value End With For i = 1 To UBound(NX) If NX(i, 15) = Target Then ton = ton + NX(i, 18) - NX(i, 21): k = k + 1 res(k, 1) = NX(i, 1): res(k, 2) = NX(i, 7): res(k, 3) = NX(i, 6) res(k, 6) = NX(i, 18): res(k, 8) = NX(i, 21): res(k, 10) = ton End If Next If k > 0 Then Range("A15").Resize(k, 10).Value = res End Sub

Em cảm ơn anh, code của anh rất nhanh ạ, em mới học vba được 2 tháng cũng chỉ biết căn bản và tự tìm hiểu trên mạng là chính, có nhiều ý tưởng nhưng trình độ hiểu biết còn kém, muốn hỏi ai đó cũng khó, đánh phải nhờ các tiền bối trên diễn đàn. Được các anh chỉ dạy e thật sự rất vui

bebo021999 · 14/3/23

satoshi99 đã viết:
em mới học vba được 2 tháng cũng chỉ biết căn bản và tự tìm hiểu trên mạng là chính, có nhiều ý tưởng nhưng trình độ hiểu biết còn kém

Mới học VBA thì chuyện này bình thường thôi mà. Trước khi bắt tay vô viết code, nên chọn đường đi trước, nếu đường đi đúng thì sẽ mau đến, nếu chọn sai thì mất thời gian mà không biết có đến đích không.
Bạn chỉ nghĩ đơn giản là tìm phát sinh NX của từng mã, rồi tìm cách lưu lại các mã có PS âm. Và việc in ra sheet 1000 lần cho 1000 mã làm cho code của bạn chạy chậm và nặng nề.
Bây giờ là lúc bạn nên nghiên cứu và mảng (array) và dictionary .

Nhật Anh 9x · 14/3/23

bebo021999 đã viết:
Cách của bạn làm rất là tốn tài nguyên: Duyệt qua từng mã NVL, in ra sheet the kho, rồi lại tiếp tục qua mã khác...chỉ nhằm mục đích kiểm tra số âm?
Vậy cái sheet thẻ kho của bạn muốn in ra chi tiết của 1 NVL nào đó thì làm thế nào?
Phương án của mình thế này: code có 2 phần

Phần 1: kiểm tra số âm: sub này dành cho button "ktra âm TD2"
Code này đặt trong general module

PHP:

Option Explicit Sub test_Am() Dim lr&, i&, NX, dic As Object, Am As Object Set dic = CreateObject("Scripting.Dictionary") Set Am = CreateObject("Scripting.Dictionary") With Sheets("Nhap-Xuat") lr = .Cells(Rows.Count, "A").End(xlUp).Row NX = .Range("A10:U" & lr).Value For i = 1 To UBound(NX) If Not dic.exists(NX(i, 15)) Then dic.Add NX(i, 15), NX(i, 18) - NX(i, 21) Else dic(NX(i, 15)) = dic(NX(i, 15)) + NX(i, 18) - NX(i, 21) If dic(NX(i, 15)) < 0 And Not Am.exists(NX(i, 15)) Then Am.Add NX(i, 15), "" End If Next End With MsgBox "Ban co " & Am.Count & " ma am thoi diem la: " & Join(Am.keys, ", ") End Sub

Phần 2: In thẻ kho. Tại sheet thekho, nhập mã vô F7 sẽ tự động in thẻ kho của mã đó.
Code đặt trong sheet module nhé.

PHP:

Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address(0, 0) <> "F7" Then Exit Sub Dim lr&, i&, k&, ton, NX, dic As Object, res(1 To 100000, 1 To 10) Set dic = CreateObject("Scripting.Dictionary") With Sheets("Nhap-Xuat") lr = .Cells(Rows.Count, "A").End(xlUp).Row NX = .Range("A10:U" & lr).Value End With For i = 1 To UBound(NX) If NX(i, 15) = Target Then ton = ton + NX(i, 18) - NX(i, 21): k = k + 1 res(k, 1) = NX(i, 1): res(k, 2) = NX(i, 7): res(k, 3) = NX(i, 6) res(k, 6) = NX(i, 18): res(k, 8) = NX(i, 21): res(k, 10) = ton End If Next If k > 0 Then Range("A15").Resize(k, 10).Value = res End Sub

Anh cho em hỏi chút là, trong thẻ kho của em ở Ô J14 nó có 1 lượng tồn đầu kỳ nên khi đổ dữ liệu từ dòng 15 thì tồn cuối tương ứng dòng 15 sẽ bắt đầu bằng tồn đầu j14+ nhập f15 - xuất h15 như vậy mình cần sửa lại như thế nào ạ vì RES của mình trả kết quả từ A15, Trước vì em không biết cách làm nên em để cho dữ liệu chạy hết còn cột J em dùng vòng lặp chạy lại nên như anh nói đấy ạ, rất mất tài nguyên

bebo021999 · 14/3/23

J14 là tồn đầu kỳ của mã nào?
Nếu các mã đều có tồn đầu kỳ thì nên nhập SL đầu kỳ vào sheet lưu tên mã nhé.
Nếu vậy bạn cập nhật rồi gửi lại file rồi tính tiếp nhé.

Nhật Anh 9x · 14/3/23

bebo021999 đã viết:
J14 là tồn đầu kỳ của mã nào?
Nếu các mã đều có tồn đầu kỳ thì nên nhập SL đầu kỳ vào sheet lưu tên mã nhé.
Nếu vậy bạn cập nhật rồi gửi lại file rồi tính tiếp nhé.

Vâng em gửi lại file đã cập nhập tồn đầu ki vào sheet MANPL ạ, số lương tồn đầu của em sẽ được điền vào ô J14 của thẻ kho tương ứng với từng mã NPL anh nhé. Anh xem giúp em với ạ

bebo021999 · 14/3/23

Trước tiên ngoài bảng tính, bạn vào thẻ Formula, bạn set về Automatic nhé
Sheet Thekho, ô J14 dùng VLOOKUP lấy số dư đầu
Ô F7 mình dùng DataValidation

Nhật Anh 9x · 14/3/23

bebo021999 đã viết:
Trước tiên ngoài bảng tính, bạn vào thẻ Formula, bạn set về Automatic nhé
Sheet Thekho, ô J14 dùng VLOOKUP lấy số dư đầu
Ô F7 mình dùng DataValidation

em cảm ơn anh đã chỉ dạy em tận tình

Nhật Anh 9x · 15/3/23

bebo021999 đã viết:
Mới học VBA thì chuyện này bình thường thôi mà. Trước khi bắt tay vô viết code, nên chọn đường đi trước, nếu đường đi đúng thì sẽ mau đến, nếu chọn sai thì mất thời gian mà không biết có đến đích không.
Bạn chỉ nghĩ đơn giản là tìm phát sinh NX của từng mã, rồi tìm cách lưu lại các mã có PS âm. Và việc in ra sheet 1000 lần cho 1000 mã làm cho code của bạn chạy chậm và nặng nề.
Bây giờ là lúc bạn nên nghiên cứu và mảng (array) và dictionary .

Qua những bài các anh chỉ dạy, em cũng xem lại code tìm hiểu để hiểu code hơn, học hỏi được gì, và áp dụng được gì cho những bài sau. code của em viết còn rườm ra hoặc cách dùng chưa hiểu quả, nhưng em sẽ cố gắng, từ bài đăng này em rút được kinh nghiệm về cách đăng bài như thế nào cho đầy đủ người đọc dễ hiểu nữa. Em là người mới sẽ có nhiều sai sót mong các anh chị bỏ qua cho em

Ghi lại các mã nguyên phụ liệu bị âm

Thành viên chính thức

Thành viên gạo cội

Thành viên chính thức

Thành viên gạo cội

Thành viên chính thức

File đính kèm

Bad Excel Member

Thành viên chính thức

Bad Excel Member

Thành viên chính thức

Thành viên gạo cội

File đính kèm

Bad Excel Member

Thành viên chính thức

Thành viên gạo cội

Thành viên chính thức

Thành viên gạo cội

Thành viên chính thức

File đính kèm

Thành viên gạo cội

File đính kèm

Thành viên chính thức

Thành viên chính thức