Cộng dồn theo mã hàng bằng VBA

[thinhnx22]

Chào các bạn,
Trong file đính kèm, mình cần cộng dồn số lượng và thành tiền ở cột F và G trong sheet nhập xuất.
Các bạn giúp mình với số liệu trong file.
Chân thành cảm ơn!

 

[HieuCD]

Chào các bạn,
Trong file đính kèm, mình cần cộng dồn số lượng và thành tiền ở cột F và G trong sheet nhập xuất.
Các bạn giúp mình với số liệu trong file.
Chân thành cảm ơn!

Làm luôn cột thành tiền

Sub CongDon()
  Dim aTon(), aNX(), Res(), iKey$, Arr As Variant
  Dim sRow&, i&
 
  With Sheets("Tondauky")
    aTon = .Range("A5:C" & .Range("A" & Rows.Count).End(xlUp).Row).Value
  End With
  With Sheets("NHAP-XUAT")
    aNX = .Range("A7:D" & .Range("A" & Rows.Count).End(xlUp).Row).Value
  End With
 
  With CreateObject("scripting.dictionary")
    sRow = UBound(aTon)
    For i = 1 To sRow
      If Len(aTon(i, 1)) > 0 Then .Item(aTon(i, 1)) = Array(aTon(i, 2), aTon(i, 3))
    Next i
    sRow = UBound(aNX)
    ReDim Res(1 To sRow, 1 To 3)
    For i = 1 To sRow
      Res(i, 1) = aNX(i, 3) * aNX(i, 4)
      iKey = aNX(i, 2)
      Arr = .Item(iKey)
      If TypeName(Arr) = "Variant()" Then
        If aNX(i, 1) = "N" Then
          Arr(0) = Arr(0) + aNX(i, 3)
          Arr(1) = Arr(1) + Res(i, 1)
        Else
          Arr(0) = Arr(0) - aNX(i, 3)
          Arr(1) = Arr(1) - Res(i, 1)
        End If
        Res(i, 2) = Arr(0): Res(i, 3) = Arr(1)
        .Item(iKey) = Arr
      End If
    Next i
  End With
  Sheets("NHAP-XUAT").Range("E7").Resize(sRow, 3).Value = Res
End Sub

 

[thinhnx22]

Làm luôn cột thành tiền

Sub CongDon()
  Dim aTon(), aNX(), Res(), iKey$, Arr As Variant
  Dim sRow&, i&

  With Sheets("Tondauky")
    aTon = .Range("A5:C" & .Range("A" & Rows.Count).End(xlUp).Row).Value
  End With
  With Sheets("NHAP-XUAT")
    aNX = .Range("A7:D" & .Range("A" & Rows.Count).End(xlUp).Row).Value
  End With

  With CreateObject("scripting.dictionary")
    sRow = UBound(aTon)
    For i = 1 To sRow
      If Len(aTon(i, 1)) > 0 Then .Item(aTon(i, 1)) = Array(aTon(i, 2), aTon(i, 3))
    Next i
    sRow = UBound(aNX)
    ReDim Res(1 To sRow, 1 To 3)
    For i = 1 To sRow
      Res(i, 1) = aNX(i, 3) * aNX(i, 4)
      iKey = aNX(i, 2)
      Arr = .Item(iKey)
      If TypeName(Arr) = "Variant()" Then
        If aNX(i, 1) = "N" Then
          Arr(0) = Arr(0) + aNX(i, 3)
          Arr(1) = Arr(1) + Res(i, 1)
        Else
          Arr(0) = Arr(0) - aNX(i, 3)
          Arr(1) = Arr(1) - Res(i, 1)
        End If
        Res(i, 2) = Arr(0): Res(i, 3) = Arr(1)
        .Item(iKey) = Arr
      End If
    Next i
  End With
  Sheets("NHAP-XUAT").Range("E7").Resize(sRow, 3).Value = Res
End Sub

Đã đúng yêu cầu rồi ạ. Cảm ơn bác nhiều.