Viết VBA cho Báo cáo - Nhập - Xuất - Tồn & kiểm hàng

[soledad_90]

Em có 1 file Excel đính kèm :
Mong nhận được sự giúp đỡ từ diễn đàn, và từ cá nhân thầy @Ba Tê với ngôn ngữ lập trình của VBA.
Tổng 3 yêu cầu cho file này:

1./ Data_báo cáo - Tự động cập nhật Tồn đk + Nhập Tk - Xuất TK
2./ Data_Kiểm khách hàng - Tự động báo hiệu "nhập kho " với mục tham chiếu tại Data_nhập kho
3./Data_Xuất kho ( tương tự như Data_kiểm hàng : là báo hiệu "đã kiểm " với mục tham chiếu tại Data_kiểm hàng

Customer

Order No

STYLE

Color

Tồn đầu kỳ

Nhập trong kỳ

Xuất trong kỳ

Tồn cuối kỳ

Xin cảm ơn !

 

[SA_DQ]

Bạn muốn làm nhờ VBA thì tên trang tính như hiện nay là không phù hợp cho lắm
1./ Quá dài, tồn tiền của công sức của bạn & của XH;
Thay vì 'Data_Nhập kho' sao không là 'NKho', & thay vì 'Data_Báo cáo' sao không là 'BaoCao' hay thậm chí là 'BCao'
2./ Nhất là không nên chứa tiếng Việt có dấu vì sự tồn vong vĩnh cữu của chúng trong mọi thời đại

 

[soledad_90]

Bạn muốn làm nhờ VBA thì tên trang tính như hiện nay là không phù hợp cho lắm
1./ Quá dài, tồn tiền của công sức của bạn & của XH;
Thay vì 'Data_Nhập kho' sao không là 'NKho', & thay vì 'Data_Báo cáo' sao không là 'BaoCao' hay thậm chí là 'BCao'
2./ Nhất là không nên chứa tiếng Việt có dấu vì sự tồn vong vĩnh cữu của chúng trong mọi thời đại

cảm ơn đóng góp của bạn. File đã được chỉnh sửa đặt tên cho phù hợp với tính năng.
Tiếp theo bài làm mình mong hỗ trợ thêm từ bạn mục VBA cho HANGKIEM, như file đính kèm, thầy @Ba Tê đã có hỗ trợ VBA mục báo cáo .
cảm ơn bạn nhiều!

 

[Ba Tê]

cảm ơn đóng góp của bạn. File đã được chỉnh sửa đặt tên cho phù hợp với tính năng.
Tiếp theo bài làm mình mong hỗ trợ thêm từ bạn mục VBA cho HANGKIEM, như file đính kèm, thầy @Ba Tê đã có hỗ trợ VBA mục báo cáo .
cảm ơn bạn nhiều!

Cột K, "Đối chiếu nhập kho", ít nhất bạn cũng cho vài dòng kết quả thủ công bạn muốn có để người khác "mò" ra ý muốn của bạn chứ.
Bạn giải thích có bảo đảm là mọi người sẽ "đọc hiểu" hay không?

 

[soledad_90]

Cột K, "Đối chiếu nhập kho", ít nhất bạn cũng cho vài dòng kết quả thủ công bạn muốn có để người khác "mò" ra ý muốn của bạn chứ.
Bạn giải thích có bảo đảm là mọi người sẽ "đọc hiểu" hay không?

Cảm ơn thông tin từ thầy
Em xin gửi lại kết quả làm thủ công. như file

 

[Ba Tê]

Cảm ơn thông tin từ thầy
Em xin gửi lại kết quả làm thủ công. như file

Bạn xem file này, tất cả dữ liệu trong sheet KIEMHANG là của bạn có sẵn, tôi chỉ viết code cho cột K (Đối chiếu nhập kho)

 

[soledad_90]

Bạn xem file này, tất cả dữ liệu trong sheet KIEMHANG là của bạn có sẵn, tôi chỉ viết code cho cột K (Đối chiếu nhập kho)

Cảm ơn thầy rất nhiều ạ .

 

[soledad_90]

Bạn xem file này, tất cả dữ liệu trong sheet KIEMHANG là của bạn có sẵn, tôi chỉ viết code cho cột K (Đối chiếu nhập kho)

Thầy cho e hỏi thêm 1 mục đối chiều lại dữ liệu xuất hàng :
Tại cột G của sheet X.KHO thiết lập VBA tham chiếu dữ liệu từ sheet kiểm hàng với 2 mục : K là " Đối chiếu nhập kho " và L là " Khách hàng "
Để báo bằng "đã kiểm" khi cột L "khách hàng" có số lượng và "chưa kiểm" khi cột L "khách hàng" chưa có số lượng
Giống như hình ảnh em gửi đính kèm ạ

 

[Ba Tê]

Để báo bằng "đã kiểm" khi cột L "khách hàng" có số lượng và "chưa kiểm" khi cột L "khách hàng" chưa có số lượng
Giống như hình ảnh em gửi đính kèm ạ

Tôi gởi lại "hình ảnh đính kèm" sau khi chạy Code.
Đúng hay sai thì tôi không biết vì lớn tuổi, nhìn "hình ảnh đính kèm" dữ liệu nhỏ hơn con kiến, chẳng thấy được gì.
------------------------------------------
Sao bạn lại thích "hình ảnh đính kèm" mà không gởi file đính kèm và có kết quả thủ công muốn có?
Tôi tham gia topic này đến đây là xong, con mắt nó không chịu tham gia nữa.

Public Sub s_XuatKho()
Dim Dic As Object, sArr(), dArr(), I As Long, R As Long, Txt As String, DaKiem As String, ChuaKIem As String
Set Dic = CreateObject("Scripting.Dictionary")
'-------------------------------------------------------------------------------------------'
    sArr = Sheets("KIEMHANG").Range("F3", Sheets("KIEMHANG").Range("L100000").End(xlUp)).Value
    R = UBound(sArr)
For I = 1 To R
    If sArr(I, 7) <> Empty Then
        If sArr(I, 6) Like "N*" Then
            Txt = sArr(I, 1) & "#" & sArr(I, 2) & "#" & sArr(I, 3)
            If Not Dic.Exists(Txt) Then Dic.Item(Txt) = I
        End If
    End If
Next I
'-------------------------------------------------------------------------------------------'
    DaKiem = Split(Sheets("X.KHO").Range("G2").Value, "/")(0)
    ChuaKIem = Split(Sheets("X.KHO").Range("G2").Value, "/")(1)
    sArr = Sheets("X.KHO").Range("C3", Sheets("X.KHO").Range("E100000").End(xlUp)).Value
    R = UBound(sArr)
ReDim dArr(1 To R, 1 To 1)
For I = 1 To R
    If sArr(I, 1) <> Empty Then
        Txt = sArr(I, 1) & "#" & sArr(I, 2) & "#" & sArr(I, 3)
        If Dic.Exists(Txt) Then
            dArr(I, 1) = DaKiem
        Else
            dArr(I, 1) = ChuaKIem
        End If
    End If
Next I
    Sheets("X.KHO").Range("G3").Resize(R) = dArr
Set Dic = Nothing
End Sub

 

[soledad_90]

Tôi gởi lại "hình ảnh đính kèm" sau khi chạy Code.
Đúng hay sai thì tôi không biết vì lớn tuổi, nhìn "hình ảnh đính kèm" dữ liệu nhỏ hơn con kiến, chẳng thấy được gì.
------------------------------------------
Sao bạn lại thích "hình ảnh đính kèm" mà không gởi file đính kèm và có kết quả thủ công muốn có?
Tôi tham gia topic này đến đây là xong, con mắt nó không chịu tham gia nữa.

Public Sub s_XuatKho()
Dim Dic As Object, sArr(), dArr(), I As Long, R As Long, Txt As String, DaKiem As String, ChuaKIem As String
Set Dic = CreateObject("Scripting.Dictionary")
'-------------------------------------------------------------------------------------------'
    sArr = Sheets("KIEMHANG").Range("F3", Sheets("KIEMHANG").Range("L100000").End(xlUp)).Value
    R = UBound(sArr)
For I = 1 To R
    If sArr(I, 7) <> Empty Then
        If sArr(I, 6) Like "N*" Then
            Txt = sArr(I, 1) & "#" & sArr(I, 2) & "#" & sArr(I, 3)
            If Not Dic.Exists(Txt) Then Dic.Item(Txt) = I
        End If
    End If
Next I
'-------------------------------------------------------------------------------------------'
    DaKiem = Split(Sheets("X.KHO").Range("G2").Value, "/")(0)
    ChuaKIem = Split(Sheets("X.KHO").Range("G2").Value, "/")(1)
    sArr = Sheets("X.KHO").Range("C3", Sheets("X.KHO").Range("E100000").End(xlUp)).Value
    R = UBound(sArr)
ReDim dArr(1 To R, 1 To 1)
For I = 1 To R
    If sArr(I, 1) <> Empty Then
        Txt = sArr(I, 1) & "#" & sArr(I, 2) & "#" & sArr(I, 3)
        If Dic.Exists(Txt) Then
            dArr(I, 1) = DaKiem
        Else
            dArr(I, 1) = ChuaKIem
        End If
    End If
Next I
    Sheets("X.KHO").Range("G3").Resize(R) = dArr
Set Dic = Nothing
End Sub

View attachment 238833

Cảm ơn thầy rất nhiều ạ.

 

[soledad_90]

Tôi gởi lại "hình ảnh đính kèm" sau khi chạy Code.
Đúng hay sai thì tôi không biết vì lớn tuổi, nhìn "hình ảnh đính kèm" dữ liệu nhỏ hơn con kiến, chẳng thấy được gì.
------------------------------------------
Sao bạn lại thích "hình ảnh đính kèm" mà không gởi file đính kèm và có kết quả thủ công muốn có?
Tôi tham gia topic này đến đây là xong, con mắt nó không chịu tham gia nữa.

Public Sub s_XuatKho()
Dim Dic As Object, sArr(), dArr(), I As Long, R As Long, Txt As String, DaKiem As String, ChuaKIem As String
Set Dic = CreateObject("Scripting.Dictionary")
'-------------------------------------------------------------------------------------------'
    sArr = Sheets("KIEMHANG").Range("F3", Sheets("KIEMHANG").Range("L100000").End(xlUp)).Value
    R = UBound(sArr)
For I = 1 To R
    If sArr(I, 7) <> Empty Then
        If sArr(I, 6) Like "N*" Then
            Txt = sArr(I, 1) & "#" & sArr(I, 2) & "#" & sArr(I, 3)
            If Not Dic.Exists(Txt) Then Dic.Item(Txt) = I
        End If
    End If
Next I
'-------------------------------------------------------------------------------------------'
    DaKiem = Split(Sheets("X.KHO").Range("G2").Value, "/")(0)
    ChuaKIem = Split(Sheets("X.KHO").Range("G2").Value, "/")(1)
    sArr = Sheets("X.KHO").Range("C3", Sheets("X.KHO").Range("E100000").End(xlUp)).Value
    R = UBound(sArr)
ReDim dArr(1 To R, 1 To 1)
For I = 1 To R
    If sArr(I, 1) <> Empty Then
        Txt = sArr(I, 1) & "#" & sArr(I, 2) & "#" & sArr(I, 3)
        If Dic.Exists(Txt) Then
            dArr(I, 1) = DaKiem
        Else
            dArr(I, 1) = ChuaKIem
        End If
    End If
Next I
    Sheets("X.KHO").Range("G3").Resize(R) = dArr
Set Dic = Nothing
End Sub

View attachment 238833

Thầy có thể giúp dùm em 1 yêu cầu cuối này với ạ.
Vì khi coppy code của thầy vào file chạy báo lỗi ạ .
Em xin cảm ơn ạ.

 

[Ba Tê]

Vì khi coppy code của thầy vào file chạy báo lỗi ạ .

Bạn xem ô G2 trong hình bài #9 của tôi và ô G2 trong file của bạn có gì khác?
Vậy nhé!

 

[soledad_90]

Bạn xem ô G2 trong hình bài #9 của tôi và ô G2 trong file của bạn có gì khác?
Vậy nhé!

Cảm ơn thầy rất nhiều ạ .
Em đã sử lý được rồi ạ.

 

[sg0nline]

Cảm ơn thầy rất nhiều ạ .
Em đã sử lý được rồi ạ.

CHO MÌNH XIN FILE HOÀN THÀNH VỚI BẠN

 

[soledad_90]

Cảm ơn thầy rất nhiều ạ.

Xin được sự giúp đỡ thêm của thầy @Ba Tê ạ .
Sau quá trình làm báo cáo . cái mục tồn đầu kỳ em muốn thêm dữ liệu này vào để báo cáo được đúng về bản chất.
Tại sheet BAOCAO : cột F sẽ được lấy dữ liệu từ sheet TONDKY chuyển qua
Vì như thiết kế file ban đầu khi muốn làm báo cáo em phải cho hết Tồn Đầu kỳ và Nhập trong kỳ vào 1 trường dữ liệu, nên bị sai cơ bản về báo cáo.
Em xin cảm ơn ạ!

Bài đã được tự động gộp: 3/2/21

CHO MÌNH XIN FILE HOÀN THÀNH VỚI BẠN

bạn lấy file tham khảo từ #15 trên nhé