Code cộng tổng số lượng theo tên vật tư (1 người xem)

[ninhtom1]

Nhờ các anh chị trên diễn đàn giúp em viết code cộng tổng số lượng vật tư theo tên vật tư.
Chi tiết em viết trong sheet Nhucau và sheet DangkyNH.
Xin cảm ơn các anh chị!

 

[NQ_AT]

Nhờ các anh chị trên diễn đàn giúp em viết code cộng tổng số lượng vật tư theo tên vật tư.
Chi tiết em viết trong sheet Nhucau và sheet DangkyNH.
Xin cảm ơn các anh chị!

Cộng lại rồi hiển thị ở đâu vậy bạn? sao ko dùng Sumif cho gọn

 

[ninhtom1]

Cái này phải dung code bạn ạ
Nhờ các anh chị chỉnh sửa code hộ mình
Bạn cứ nhập số biên bản, nội dung nó tự nhẩy

 

[bongmaihung]

Cái này phải dung code bạn ạ
Nhờ các anh chị chỉnh sửa code hộ mình
Bạn cứ nhập số biên bản, nội dung nó tự nhẩy

Sub Dic()
Dim Sarr, i, k, Arr
Sarr = Sheets("DangkyNH").Range("B13:H28").Value2
ReDim Arr(1 To UBound(Sarr, 1), 1 To UBound(Sarr, 2))
With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(Sarr, 1)
        If Not .exists(Sarr(i, 1)) Then
            k = k + 1
            .Add Sarr(i, 1), k
            Arr(k, 1) = Sarr(i, 4)
        Else
            Arr(.Item(Sarr(i, 1)), 1) = Arr(.Item(Sarr(i, 1)), 1) + Sarr(i, 4)
        End If
    Next
End With
Sheets("DangkyNH").[H13].Resize(k, 1) = Arr
End Sub

Bạn thử lồng đoạn code trên vào thử xem có được ko

 

[ninhtom1]

Tình hình là không được bạn ơi

 

[SA_DQ]

Option Explicit
Public Sub GPE()
 Dim sArr(), Dic As Object, Tmp
 Dim J As Long, Rws As Long, K As Long, Tmr As Double
    Tmr = Timer()
    Set Dic = CreateObject("Scripting.Dictionary")
    Rws = [B13].End(xlDown).Row
    sArr = Range("B13:B" & Rws).Resize(, 6).Value
    ReDim Arr(1 To (Rws - 9), 1 To 6)
    
    For J = 1 To UBound(sArr, 1)
        Tmp = sArr(J, 1)
        If Tmp <> "" Then
            If Not Dic.exists(Tmp) Then
                K = K + 1
                Dic.Add Tmp, K
                Arr(K, 2) = sArr(J, 2):                  Arr(K, 1) = Tmp
                Arr(K, 3) = sArr(J, 3):                  Arr(K, 4) = sArr(J, 4)
                Arr(K, 5) = sArr(J, 5):                 Arr(K, 6) = sArr(J, 6)
            Else
                Arr(Dic.Item(Tmp), 6) = Arr(Dic.Item(Tmp), 6) + sArr(J, 6)
            End If
        End If
    Next J
    [B13].Resize(Rws - 9, 6).Value = Arr()
    [I1].Value = Timer() - Tmr:                         Randomize
    [b10].Resize(2, 6).Interior.ColorIndex = 34 + 9 * Rnd() \ 1
 Set Dic = Nothing
End Sub

 

[ninhtom1]

Cảm ơn bác Hải Yến nhiều, tình hình là code của bác lọc được đúng danh mục rồi nhưng phần cộng tổng chưa chính xác. Bác chỉnh sửa giúp em nhé, bác làm hộ em mỗi sheet Nhucau với sheet DangkyNH chạy một hàm khác nhau được không. Em gửi file lên bác xem giúp em nhé.