Kính gửi anh chị và các bạn,
Em muốn tổng hợp kết quả bán hàng đã ghi như ở sheet Data liên tiếp theo các tháng vào sheet Ketqua (Chỉ lấy 5 tiêu chí: Ngày/tháng, Mã người nhập, Tên User, Mã Khach, Giá trị bán). Thì code như thế nào ạ. Em cảm ơn ạ.
Nếu dữ liệu ít thì bạn nên copy bằng tay. còn nhiều quá và ở dải rác ở nhiều cột thì thử đoạn code này xem sao. Hy vọng đúng ý.
Sub TONGHOP()
Dim Arr(), KQ()
Dim i As Long, j As Long, d As Long, col As Long, kol As Long, Cos As Long, CMa As Long, Cten As Long, CMaKh As Long
Dim WF As Object
Dim NT As String, MaNN As String, TEN As String, MaKH As String, GT As String
NT = "Ngày/tháng"
MaNN = "Mã ng??i nh?p"
TEN = "Tên User"
MaKH = "Mã Khach"
GT = "Giá tr? bán"
Set WF = WorksheetFunction
Sheets("Ket_qua").[R2].Resize(1000000, 5).ClearContents
With Sheets("Data")
col = .Cells(1, .Columns.Count).End(xlToLeft).Column
ReDim KQ(1 To 100000, 1 To 5)
For i = 1 To col
d = 0: kol = 0: Cos = 0: CMa = 0: Cten = 0: CMaKh = 0
If .Cells(1, i) <> Empty And .Cells(1, i) = NT Then
d = .Cells(.Rows.Count, i).End(xlUp).Row
kol = .Cells(1, i).End(xlToRight).Column
Cos = WF.Match(GT, .Range(.Cells(1, i), .Cells(1, kol)), 0)
If Cos <> 0 Then
CMa = WF.Match(MaNN, .Range(.Cells(1, i), .Cells(1, kol)), 0)
Cten = WF.Match(TEN, .Range(.Cells(1, i), .Cells(1, kol)), 0)
CMaKh = WF.Match(MaKH, .Range(.Cells(1, i), .Cells(1, kol)), 0)
Arr = .Range(.Cells(2, i), .Cells(d, kol)).Value
End If
For j = 1 To UBound(Arr)
t = t + 1
KQ(t, 1) = Arr(j, 1)
KQ(t, 2) = Arr(j, CMa)
KQ(t, 3) = Arr(j, Cten)
KQ(t, 4) = Arr(j, CMaKh)
KQ(t, 5) = Arr(j, Cos)
Next j
End If
Next i
End With
If t > 0 Then Sheets("Ket_qua").[R2].Resize(t, 5) = KQ
MsgBox " XONG ROI, HAY GUI LOI CAM ON ĐÊN BQT DIEN DAN VÀ CAC ANH, PTM, NDU, VETMINI, HIEUCD, SQ-DA,... NHÉ. CHUC VUI"
End Sub.
P/S : Có gì mạo phạm kính mong các anh, chị, em lượng thứ. Trân trọng
