Tính nhập, xuất, tồn theo tên nhóm

NguyenthiH · 12/7/18

Chào các anh chị.
Mong các anh chị giúp em tính nhập, xuất, tồn theo tên nhóm trong sheet!TonNhom và sheet!TonNhomDH như trong file đính kèm.

giaiphap · 12/7/18

NguyenthiH đã viết:
Chào các anh chị.
Mong các anh chị giúp em tính nhập, xuất, tồn theo tên nhóm trong sheet!TonNhom và sheet!TonNhomDH như trong file đính kèm.

Bạn dùng thử code này xem sao.

Mã:

Sub Filter_Group()
Dim Arr(), dArr(1 To 10000, 1 To 5), Dic, i As Long, j As Long, k As Long, tmp
Arr = Sheet2.Range("G2", Sheet2.Range("J65000").End(xlUp)).Value
Set Dic = CreateObject("Scripting.Dictionary")
    With Dic
        For i = 1 To UBound(Arr, 1)
            tmp = Arr(i, 1)
            If Not .Exists(tmp) Then
                k = k + 1
                .Add tmp, k
                dArr(k, 1) = Arr(i, 1): dArr(k, 2) = Arr(i, 3): dArr(k, 3) = Arr(i, 4)
            Else
                dArr(.Item(tmp), 3) = dArr(.Item(tmp), 3) + Arr(i, 4)
                dArr(.Item(tmp), 5) = dArr(.Item(tmp), 3) - dArr(.Item(tmp), 4)
            End If
        Next i
        Erase Arr
        Arr = Sheet3.Range("F2", Sheet3.Range("I65000").End(xlUp)).Value
        For i = 1 To UBound(Arr, 1)
            tmp = Arr(i, 1)
            If Not .Exists(tmp) Then
                k = k + 1
                .Add tmp, k
                dArr(k, 1) = Arr(i, 1): dArr(k, 2) = Arr(i, 3): dArr(k, 4) = Arr(i, 4)
            Else
                dArr(.Item(tmp), 4) = dArr(.Item(tmp), 4) + Arr(i, 4)
                dArr(.Item(tmp), 5) = dArr(.Item(tmp), 3) - dArr(.Item(tmp), 4)
            End If
        Next i
    End With
    Sheet4.Range("A4", Sheet4.Range("A65000").End(xlUp).Offset(,5)).ClearContents
    If k Then
        Sheet4.Range("A4").Resize(k, 5) = dArr
        ActiveWorkbook.Worksheets("TonNhom").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("TonNhom").Sort.SortFields.Add Key:=Range("A4").Resize(k), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets("TonNhom").Sort
            .SetRange Range("A3").Resize(k + 1, 5)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End If
End Sub

NguyenthiH · 12/7/18

Cám ơn anh @giaiphap!
Còn sheet!TonNHomDH mong anh giúp em với.

giaiphap · 12/7/18

NguyenthiH đã viết:
Cám ơn anh @giaiphap!
Còn sheet!TonNHomDH mong anh giúp em với.

Dùng code này.

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$B$2" Then Exit Sub
Dim Arr(), dArr(1 To 10000, 1 To 5), Dic, i As Long, j As Long, k As Long, tmp
Arr = Sheet2.Range("F2", Sheet2.Range("J65000").End(xlUp)).Value
Set Dic = CreateObject("Scripting.Dictionary")
    With Dic
        For i = 1 To UBound(Arr, 1)
            If Arr(i, 1) = Target.Value Then
                tmp = Arr(i, 2)
                If Not .Exists(tmp) Then
                    k = k + 1
                    .Add tmp, k
                    dArr(k, 1) = Arr(i, 2): dArr(k, 2) = Arr(i, 4): dArr(k, 3) = Arr(i, 5)
                Else
                    dArr(.Item(tmp), 3) = dArr(.Item(tmp), 3) + Arr(i, 5)
                    dArr(.Item(tmp), 5) = dArr(.Item(tmp), 3) - dArr(.Item(tmp), 4)
                End If
            End If
        Next i
        Erase Arr
        Arr = Sheet3.Range("E2", Sheet3.Range("I65000").End(xlUp)).Value
        For i = 1 To UBound(Arr, 1)
            If Arr(i, 1) = Target.Value Then
                tmp = Arr(i, 2)
                If Not .Exists(tmp) Then
                    k = k + 1
                    .Add tmp, k
                    dArr(k, 1) = Arr(i, 2): dArr(k, 2) = Arr(i, 4): dArr(k, 4) = Arr(i, 5)
                Else
                    dArr(.Item(tmp), 4) = dArr(.Item(tmp), 4) + Arr(i, 5)
                    dArr(.Item(tmp), 5) = dArr(.Item(tmp), 3) - dArr(.Item(tmp), 4)
                End If
            End If
        Next i
    End With
    Application.EnableEvents = False
    Sheet5.Range("A5", Sheet5.Range("A65000").End(xlUp).Offset(2)).ClearContents
    If k Then Sheet5.Range("A5").Resize(k, 5) = dArr
    Application.EnableEvents = True
End Sub

NguyenthiH · 12/7/18

Cám ơn anh @giaiphap!
Code cho Sheet!TonNhomDH chưa đúng anh ơi
Em ví dụ khi chọn đơn hang 18F168 thì tên nhóm có 10 mục, khi chọn đơn hang 18F125 thì tên nhóm chỉ có 8 mục, 2 mục dưới cùng không có tên nhóm (của đơn hang 18F168) không bị xóa đi.
Mong anh xem lại giúp em.

giaiphap · 12/7/18

NguyenthiH đã viết:
Cám ơn anh @giaiphap!
Code cho Sheet!TonNhomDH chưa đúng anh ơi
Em ví dụ khi chọn đơn hang 18F168 thì tên nhóm có 10 mục, khi chọn đơn hang 18F125 thì tên nhóm chỉ có 8 mục, 2 mục dưới cùng không có tên nhóm (của đơn hang 18F168) không bị xóa đi.
Mong anh xem lại giúp em.

Do mình nhằm, bạn xem lại.

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$B$2" Then Exit Sub
Dim Arr(), dArr(1 To 10000, 1 To 5), Dic, i As Long, j As Long, k As Long, tmp
Arr = Sheet2.Range("F2", Sheet2.Range("J65000").End(xlUp)).Value
Set Dic = CreateObject("Scripting.Dictionary")
    With Dic
        For i = 1 To UBound(Arr, 1)
            If Arr(i, 1) = Target.Value Then
                tmp = Arr(i, 2)
                If Not .Exists(tmp) Then
                    k = k + 1
                    .Add tmp, k
                    dArr(k, 1) = Arr(i, 2): dArr(k, 2) = Arr(i, 4): dArr(k, 3) = Arr(i, 5)
                Else
                    dArr(.Item(tmp), 3) = dArr(.Item(tmp), 3) + Arr(i, 5)
                    dArr(.Item(tmp), 5) = dArr(.Item(tmp), 3) - dArr(.Item(tmp), 4)
                End If
            End If
        Next i
        Erase Arr
        Arr = Sheet3.Range("E2", Sheet3.Range("I65000").End(xlUp)).Value
        For i = 1 To UBound(Arr, 1)
            If Arr(i, 1) = Target.Value Then
                tmp = Arr(i, 2)
                If Not .Exists(tmp) Then
                    k = k + 1
                    .Add tmp, k
                    dArr(k, 1) = Arr(i, 2): dArr(k, 2) = Arr(i, 4): dArr(k, 4) = Arr(i, 5)
                Else
                    dArr(.Item(tmp), 4) = dArr(.Item(tmp), 4) + Arr(i, 5)
                    dArr(.Item(tmp), 5) = dArr(.Item(tmp), 3) - dArr(.Item(tmp), 4)
                End If
            End If
        Next i
    End With
    Application.EnableEvents = False
    Sheet5.Range("A5", Sheet5.Range("A65000").End(xlUp).Offset(, 5)).ClearContents
    If k Then Sheet5.Range("A5").Resize(k, 5) = dArr
    Application.EnableEvents = True
End Sub

Sẳn sửa luôn code #2 luôn, nhìn nhằm số 5 và số 2.

Ba Tê · 12/7/18

NguyenthiH đã viết:
Chào các anh chị.
Mong các anh chị giúp em tính nhập, xuất, tồn theo tên nhóm trong sheet!TonNhom và sheet!TonNhomDH như trong file đính kèm.

NguyenthiH · 12/7/18

Cám ơn anh @giaiphap và Thầy Ba Tê nhiều.
Mà sao file của Thầy Ba Tê, ở sheet!TonNhom không có mục "Bao Nylon" trong tên nhóm. Mong Thầy xem giúp em.

Ba Tê · 12/7/18

NguyenthiH đã viết:
Cám ơn anh @giaiphap và Thầy Ba Tê nhiều.
Mà sao file của Thầy Ba Tê, ở sheet!TonNhom không có mục "Bao Nylon" trong tên nhóm. Mong Thầy xem giúp em.

Bài #7 tôi hiểu theo hình dưới, không báo cáo là không liệt kê ra.
Nếu muốn liệt kê luôn thì càng gọn hơn. Xem file này.

Tính nhập, xuất, tồn theo tên nhóm

NguyenthiH

Thành viên mới đăng ký

File đính kèm

giaiphap

==(^o^)==

NguyenthiH

Thành viên mới đăng ký

giaiphap

==(^o^)==

NguyenthiH

Thành viên mới đăng ký

giaiphap

==(^o^)==

Ba Tê

Cạo Rồi Khỏi Gội

File đính kèm

NguyenthiH

Thành viên mới đăng ký

Ba Tê

Cạo Rồi Khỏi Gội

File đính kèm

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian