Nhờ viết code copy và tổng hợp dữ liệu từ sheet này sang sheet khác (1 người xem)

[littlecat1987]

Nhờ các cao thủ trong nhà giúp mình viết code cho file đính kèm

Mình có 2 sheet nhaplieu va tonghop
- Dữ liệu sẽ được nhập bên sheet nhaplieu, có các dòng giống nhau về số phiếu và mặt hàng
- Mục đích của mình là copy các dòng không trùng nhau về số phiếu và mặt hàng sang sheet tonghop, sau đó sẽ tính tổng cộng số lượng, đơn giá bình quân của các dòng trùng nhau.

 

[Quang_Hải]

Nhờ các cao thủ trong nhà giúp mình viết code cho file đính kèm

Mình có 2 sheet nhaplieu va tonghop
- Dữ liệu sẽ được nhập bên sheet nhaplieu, có các dòng giống nhau về số phiếu và mặt hàng
- Mục đích của mình là copy các dòng không trùng nhau về số phiếu và mặt hàng sang sheet tonghop, sau đó sẽ tính tổng cộng số lượng, đơn giá bình quân của các dòng trùng nhau.

Mình tuy không phải cao thủ nhưng cũng thử code coi có được không

Sub tonghop()
Dim nguon(), Kq(), dk As String, I As Long, J As Long, K As Long
With Sheets("nhap lieu")
   nguon = .Range(.[A3], .[A65536].End(3)).Resize(, 10).Value
End With
ReDim Kq(1 To UBound(nguon), 1 To 5)
With CreateObject("scripting.dictionary")
   For I = 1 To UBound(nguon)
      dk = nguon(I, 1) & nguon(I, 2)
      If Not .exists(dk) Then
         K = K + 1
         .Add dk, K
         Kq(K, 1) = nguon(I, 1)
         Kq(K, 2) = nguon(I, 2)
         Kq(K, 3) = nguon(I, 4)
         Kq(K, 5) = nguon(I, 10)
      Else
         J = .Item(dk)
         Kq(J, 3) = Kq(J, 3) + nguon(I, 4)
         Kq(K, 5) = Kq(K, 5) + nguon(I, 10)
      End If
      Kq(K, 4) = Kq(K, 5) / Kq(K, 3)
   Next
End With
Sheets("tong hop").[A3:E10000].ClearContents
If K Then Sheets("tong hop").[A3].Resize(K, 5) = Kq
End Sub

 

[Ba Tê]

Mình tuy không phải cao thủ nhưng cũng thử code coi có được không

Sub tonghop()
Dim nguon(), Kq(), dk As String, I As Long, J As Long, K As Long
With Sheets("nhap lieu")
   nguon = .Range(.[A3], .[A65536].End(3)).Resize(, 10).Value
End With
ReDim Kq(1 To UBound(nguon), 1 To 5)
With CreateObject("scripting.dictionary")
   For I = 1 To UBound(nguon)
      dk = nguon(I, 1) & nguon(I, 2)
      If Not .exists(dk) Then
         K = K + 1
         .Add dk, K
         Kq(K, 1) = nguon(I, 1)
         Kq(K, 2) = nguon(I, 2)
         Kq(K, 3) = nguon(I, 4)
         Kq(K, 5) = nguon(I, 10)
      Else
         J = .Item(dk)
         Kq(J, 3) = Kq(J, 3) + nguon(I, 4)
         Kq(K, 5) = Kq(K, 5) + nguon(I, 10)
      End If
      Kq(K, 4) = Kq(K, 5) / Kq(K, 3)
   Next
End With
Sheets("tong hop").[A3:E10000].ClearContents
If K Then Sheets("tong hop").[A3].Resize(K, 5) = Kq
End Sub

Hi hi...
Chưa kiểm tra kết quả nhưng thấy mấy cái J, K này hình như chưa ổn lắm à nghe.

J = .Item(dk)
         Kq(J, 3) = Kq(J, 3) + nguon(I, 4)
         Kq(K, 5) = Kq(K, 5) + nguon(I, 10)
      End If
      Kq(K, 4) = Kq(K, 5) / Kq(K, 3)

 

[Quang_Hải]

Hi hi...
Chưa kiểm tra kết quả nhưng thấy mấy cái J, K này hình như chưa ổn lắm à nghe.

J = .Item(dk)
         Kq(J, 3) = Kq(J, 3) + nguon(I, 4)
         Kq(K, 5) = Kq(K, 5) + nguon(I, 10)
      End If
      Kq(K, 4) = Kq(K, 5) / Kq(K, 3)

Nhìn lại thì hình như là không ổn. Hình như phải là Kq(J, 5) = Kq(J, 5) + nguon(I, 10)
Mà thôi kệ đi, khi nào khổ chủ la lên là sai thì mần tiếp.

 

[littlecat1987]

Nhờ bạn giúp mình thêm một code lọc được dữ liệu từ 2 sheet "nhap lieu", "tong hop" sang sheet "loc"

 

[littlecat1987]

Cám ơn bạn về code, nhưng mà có một vấn đề là dữ liệu giống nhau nếu để cách dòng, công lại sẽ bị sai.
Mình nhờ bạn giúp mình thêm một code lọc được dữ liệu từ 2 sheet "nhap lieu", "tong hop" sang sheet "loc"