tính số lượng tồn (1 người xem)

[Rùa Con 1080]

Em có tạo Form Xuất, khi tìm tên phụ liệu trong tb_Search và chọn tên phụ liệu trong ListBox1, nhấn enter thì đập tên phụ liệu và ĐVT vào listBox2. Lúc này nhờ mọi người viết code để tính SL Tồn của Tên phụ liệu đó trong tb_SLT theo tên phụ liệu trong tb_TPL.
Cách tính như sau:
em xin ví dụ:
1/ nếu tb_TPL là "Băng Keo Đỏ" thì:
có số lượng tồn là 6 (Sheet4!C), số lượng nhập là 0 (Sheet2!D), số lượng xuất 3 (Sheet3!F) thì lúc tb_SLT là 3 (tức là = Tồn+ Nhập - Xuất)
2/ nếu tb_TPL là "Keo 2Cm" thì:
có số lượng tồn là 45 (Sheet4!C), số lượng nhập là 57 (Sheet2!D), số lượng xuất 50 (Sheet3!F) thì lúc này tb_SLT là 52.(45+57-50=52)
*****tức cách tính SL Tồn(tb_SLT) là =tồn của tên phụ liệu trong tb_TPL(trong Sheet4!C)+Tổng Nhập của phụ liệu đó(trong Sheet2!D)-tổng xuất của phụ liệu đó(trong Sheet3!F)********
Mong mọi người giúp đỡ!!!!!

 

[SA_DQ]

Mình fải thêm nút lệnh riêng, kẻo xung đột với chương trình sẵn có của bạn.

Bổ sung:

Nếu có nhập hay xuất nhiều lần thì f ải xài cái ni thay thế:

Sub TinhTNX(Col As Byte)
 Dim Sh As Worksheet, Rng As Range, sRng As Range
 Dim ShName As String, MyAdd As String
 Dim Cot As Integer
 
 If Col = 1 Then
    ShName = "Ton":                             Cot = 0
 ElseIf Col = 2 Then
    ShName = "Nhap":                            Cot = 1
 ElseIf Col = 3 Then
    ShName = "Xuat":                            Cot = 3
 End If
 Set Sh = ThisWorkbook.Worksheets(ShName)
 Set Rng = Sh.Columns("A:A").Offset(, Cot)
 Set sRng = Rng.Find(Me!tb_TPL.Text, , xlFormulas, xlWhole)
 If Not sRng Is Nothing Then
1    MyAdd = sRng.Address
    Do
        SL = SL + IIf(Cot = 3, -1, 1) * sRng.Offset(, 2).Value
        Set sRng = Rng.FindNext(sRng)
5    Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
 Else
 End If
End Sub

 

[Rùa Con 1080]

Cám ơn bạn HYen17, nếu bỏ được nút cmdTon thì quá hay luôn, mình thử cài vào trong sự kiện ListBox1_KeyDown() nhưng trình độ VBA kém quá nên không được.
Ah!!! Đúng rồi, file mình đưa chỉ nhập và xuất một làn, chứ thực tế nhập và xuất rất nhiều lần.

 

[Rùa Con 1080]

Bạn HYen17 bỏ dùm nút cmdTon luôn đi ah, khi nhấn enter ở ListBox1 thì hiện SL Tồn của phụ liệu đó luôn Ah!!!!

 

[ChanhTQ@]

Vậy thì bạn chịu khó bấm double vô ListBox1 đi vậy!

 

[Rùa Con 1080]

Chỉ có cách Double Click vào ListBox1 thôi hả Thầy??? Không Enter trong ListBox1 được hả Thầy????

 

[Rùa Con 1080]

Mong Thầy và mọi người có thể viết Code để khi chọn phụ liệu (Bằng bàn Phím) trong ListBox1 rồi enter thì hiện luôn SL Tồn!!!!!

 

[SA_DQ]

Bạn ghi thêm vài câu lệnh trong 1 macro như sau:

Private Sub HoTro_ListBox1()
 On Error GoTo Thoat
1 tb_TPL = Me.ListBox1.Column(0)
2 tb_DVT = Me.ListBox1.Column(1)
3    tb_SL.SetFocus
5    TinhTNX 1
6    TinhTNX 2
7    TinhTNX 3
8    Me!tb_SLT.Value = SL:                  SL = 0
4    Exit Sub
Thoat:
    MsgBox Err, , Erl()
    MsgBox ("ban dang click vao` vung` trong'"), vbExclamation
End Sub

Chúc thành công!

 

[Rùa Con 1080]

Em có viết đoạn code này để khi giá trị của tb_SL mà lớn hơn giá trị của tb_SLT thì có msgBox"khong xuat duoc" và xóa tb_SL và tb_SL.SetFocus, Nhưng không được,mong mọi người xem giúp.
Private Sub tb_SL_AfterUpdate()
If tb_SL.Value > tb_SLT.Value Then MsgBox ("khong xuat duoc"), , "GPE": Exit Sub
tb_SL = ""
tb_SL.SetFocus
tb_SL.Value = Format(tb_SL.Value, "#,##0.00")
End Sub

 

[SA_DQ]

Hình như bạn cần là macro có nội dung sau:

Private Sub tb_SL_AfterUpdate()
 If Me!tb_SL.Value > Me!tb_SLT.Value Then
    MsgBox ("Khong Xuát Duoc"), , "GPE"
    Me!tb_SL = "":                  Exit Sub
 End If
 Me!tb_SL.SetFocus
 Me!tb_SL.Value = Format(tb_SL.Value, "#,##0.00")
End Sub

 

[Rùa Con 1080]

Oh!!!!!Cám ơn bạn HYen17, bạn cho mình hỏi sao có "Me!" trước textBox vậy????
Cám ơn Bạn nhiều vì sự giúp đỡ đầu tiên!!!!!

 

[Rùa Con 1080]

Ah!!! Bây giờ mình mới thử code thì chưa đúng bạn HYen17 ơi,có msgBox, có tb_SL="", nhưng chưa Focus textBoxSL(khi hiện msgBox nhân Enter thì con trỏ ở tb_GC.

 

[Rùa Con 1080]

Sao em chèn đoạn code này vào trong Sub cmd__GHI, để ghi xong thì xóa tb_SLT, nhưng sao không được, mong mọi người giúp đỡ
Private Sub cmd_GHI_Click()
Dim i As Integer, n As Long


If tb_Ngay = "" Then MsgBox ("Ban chua nhap Ngay/Thang/Nam"), , "GPE": Exit Sub
If ListBox2.ListCount = 0 Then MsgBox ("ban chua cap nhat Noi dung vao Listbox"), , "GPE": Exit Sub


Application.ScreenUpdating = False 'giup code chay. nhanh hon
irow = Sheet3.[A65536].End(3)(2).Row 'xac dinh row cuoi cung` chua' du~ lieu


For i = 0 To ListBox2.ListCount - 1
Sheet3.Cells(irow + n, 1) = CDate(tb_Ngay)
Sheet3.Cells(irow + n, 2) = Application.Proper(tb_XN)
Sheet3.Cells(irow + n, 3) = UCase(tb_DH)
With ListBox2
Sheet3.Cells(irow + n, 4) = .List(i, 1) 'TPL
Sheet3.Cells(irow + n, 5) = .List(i, 2) 'DVT
Sheet3.Cells(irow + n, 6).NumberFormat = "#,##0.00" 'SL
Sheet3.Cells(irow + n, 6) = CDbl(.List(i, 3)) 'SL
Sheet3.Cells(irow + n, 7) = .List(i, 4) 'GC
End With
n = n + 1
Next
tb_Ngay = tb_XN = ""
tb_DH = tb_SL = ""
tb_GC = tb_TPL = ""
tb_DVT = tb_SLT = "" <----thêm chổ này
ListBox1.Clear: ListBox2.Clear
tb_Ngay.SetFocus
Application.ScreenUpdating = True
MsgBox ("cap nhat xong"), , "GPE"
End Sub

 

[Rùa Con 1080]

Mong mọi người ghé qua giúp đỡ em với!!!!!!

 

[Rùa Con 1080]

Sao mò cả buổi không ra!!!!!! Mọi người giúp với!!!

 

[Rùa Con 1080]

Đã 2 ngày rồi mà không thấy Bạn HYen17 quay lại giúp mình với.

 

[SA_DQ]

[thongbao]

Private Sub cmd_GHI_Click()
 Dim I As Integer, N As Long, iRow As Long
 If tb_Ngay = "" Then
    MsgBox ("Ban chua nhap Ngay/Thang/Nam"), , "GPE":           Exit Sub
 End If
 If ListBox2.ListCount = 0 Then
    MsgBox ("ban chua cap nhat Noi dung vao Listbox"), , "GPE": Exit Sub
 End If
 Application.ScreenUpdating = False 'Giúp Code Chay. Nhanh Hon'
 iRow = Sheet3.[A65536].End(3)(2).Row  'Xác Dinh Ḍng Cuói Cùng` Chúa Du Lieu'
 For I = 0 To ListBox2.ListCount - 1
    Sheet3.Cells(iRow + N, 1) = CDate(tb_Ngay)
    Sheet3.Cells(iRow + N, 2) = Application.Proper(tb_XN)
    Sheet3.Cells(iRow + N, 3) = UCase(tb_DH)
    With ListBox2
        Sheet3.Cells(iRow + N, 4) = .List(I, 1)                       'TPL  '
        Sheet3.Cells(iRow + N, 5) = .List(I, 2)                       'DVT  '
        Sheet3.Cells(iRow + N, 6).NumberFormat = "#,##0.00"           'SL   '
        Sheet3.Cells(iRow + N, 6) = CDbl(.List(I, 3))                 'SL   '
        Sheet3.Cells(iRow + N, 7) = .List(I, 4)                       'GC   '
    End With
    N = N + 1
 Next I
 tb_Ngay = "":                          tb_XN = ""
 tb_DH = "":                            tb_SL = ""
 tb_GC = "":                            tb_TPL = ""
6 tb_DVT = "":                           '*'
 ListBox1.Clear:                        ListBox2.Clear
 tb_Ngay.SetFocus
9
 Application.ScreenUpdating = True
 MsgBox ("Cap Nhat Xong"), , "GPE"
End Sub

[/thongbao]

Bạn thử theo 2 bước sau & cho biết từng kết quả:

B1: Thử vô hiệu hóa dòng lệnh có fương thức SetFocus
(Tại mệnh đề 2 của dòng lệnh mang số 6 vẫn thêm câu lệnh mà bạn muốn)

B2: (Vẫn có dòng lệnh ....SetFocus
Nhưng bạn đem dòng lệnh muốn thêm xuống đến dòng có đánh số 9

 

[Rùa Con 1080]

Cám ơn Bạn HYen17!!!! Mình mới Online thì thấy bạn, mình mới thử, thì thấy cả hai bước đều có vấn đề:
Đã xóa tb_SLT, nhưng khi xuất nhiều hơn một mặt hàng thì code chạy sai, ví dụ như xuất bao 40 X 62 xong, đến xuất bao 44 X 62 thì mặc dù tb_slt lớn hơn tb_SL vẫn có msgBox báo "khong xuat duoc". Trình độ VBA mình yếu lăm, nếu được mong bạn giúp!!!!!

 

[Rùa Con 1080]

Code chắc bị xung đột làm sao ấy, mình thấy lúc chạy lúc không bạn HYen17 ơi.

 

[Rùa Con 1080]

Code trong file này là em tải trên GPE, chứ thật ra trình độ VBA của em kém lắm, nếu được mong mọi người và bạn HYen17 viết cho code mới với ý tương như sau:
1/khi gỏ tên phụ liệu vào tb_Search thì lọc các phụ liệu vào listBox1
2/khi chọn bằng bàn phím hoặc Double Click vào ListBox1 thì đập tên phụ liệu và ĐVT vào tb_TPL và tb_DVT, đồng thời hiện số lượng tồn của Phụ liệu đó vào tb_SLT.
3/Nếu gỏ số vào tb_SL mà lớn hơn giá trị của tb_SLT thì có msgBox"Khong Xuat Duoc" và xóa tb_SL và tb_SL.setFocus.
4/Khi nhấn enter ở tb_GC thì đập các tb_TPL,tb_DVT, tb_SL,tb_GC vào ListBox2, và lại nhập tiếp phụ liệu khác.
5/Khi nhấn cmd_GHI thì đập tb_Ngay, tb_XN, tb_DH và litBox2 vào Sheet"Xuat".
Nói chung giống như File này nhưng không xảy ra lỗi nữa.
Mong mọi người giúp đỡ.