AC cho em xin code Tính tổng có điều kiện Bằng VBA

[snow25]

anh chị cho em xin code VBA tính tổng có điều kiện bằng VBA với dữ liệu xuất nhập ở sheet1
cần code để tính tổng nhập xuất ở sheet2 với các mã vật tư ở sheet2.
Em cảm ơn

 

[CHAOQUAY]

anh chị cho em xin code VBA tính tổng có điều kiện bằng VBA với dữ liệu xuất nhập ở sheet1
cần code để tính tổng nhập xuất ở sheet2 với các mã vật tư ở sheet2.
Em cảm ơn

Thử code này xem sao bạn

Sub tinhtong_()
Dim arr
Dim arr1 As Variant
Dim i, j As Long
Dim a, b As Long
arr = Sheets(1).Range("b9:f" & Sheets(1).Range("b" & Rows.Count).End(xlUp).Row).Value
arr1 = Sheets(2).Range("A2:C" & Sheets(2).Range("A" & Rows.Count).End(xlUp).Row).Value
With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For i = 1 To UBound(arr)
        If .exists(arr(i, 1)) = 0 Then
            .Item(arr(i, 1)) = Array(arr(i, 4), arr(i, 5))
        Else
            a = .Item(arr(i, 1))(0)
            b = .Item(arr(i, 1))(1)
            a = a + arr(i, 4)
            b = b + arr(i, 5)
            .Item(arr(i, 1)) = Array(a, b)
        End If
    Next i
    For i = 1 To UBound(arr1)
        If .exists(arr1(i, 1)) Then
            arr1(i, 2) = .Item(arr1(i, 1))(0)
            arr1(i, 3) = .Item(arr1(i, 1))(1)
        Else
            arr1(i, 2) = 0
            arr1(i, 3) = 0
        End If
    Next i
End With
With Sheet2
.Range("e2").Resize(UBound(arr1), UBound(arr1, 2)).ClearContents
.Range("e2").Resize(UBound(arr1), UBound(arr1, 2)).Columns(1).NumberFormat = "@"
.Range("e2").Resize(UBound(arr1), UBound(arr1, 2)) = arr1
End With
End Sub

 

[snow25]

Thử code này xem sao bạn

Sub tinhtong_()
Dim arr
Dim arr1 As Variant
Dim i, j As Long
Dim a, b As Long
arr = Sheets(1).Range("b9:f" & Sheets(1).Range("b" & Rows.Count).End(xlUp).Row).Value
arr1 = Sheets(2).Range("A2:C" & Sheets(2).Range("A" & Rows.Count).End(xlUp).Row).Value
With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For i = 1 To UBound(arr)
        If .exists(arr(i, 1)) = 0 Then
            .Item(arr(i, 1)) = Array(arr(i, 4), arr(i, 5))
        Else
            a = .Item(arr(i, 1))(0)
            b = .Item(arr(i, 1))(1)
            a = a + arr(i, 4)
            b = b + arr(i, 5)
            .Item(arr(i, 1)) = Array(a, b)
        End If
    Next i
    For i = 1 To UBound(arr1)
        If .exists(arr1(i, 1)) Then
            arr1(i, 2) = .Item(arr1(i, 1))(0)
            arr1(i, 3) = .Item(arr1(i, 1))(1)
        Else
            arr1(i, 2) = 0
            arr1(i, 3) = 0
        End If
    Next i
End With
With Sheet2
.Range("e2").Resize(UBound(arr1), UBound(arr1, 2)).ClearContents
.Range("e2").Resize(UBound(arr1), UBound(arr1, 2)).Columns(1).NumberFormat = "@"
.Range("e2").Resize(UBound(arr1), UBound(arr1, 2)) = arr1
End With
End Sub

cảm ơn nhiều nhé