Lọc duy nhất và tính tổng

[huongmuine]

Nhờ các bạn giúp mình lọc và tính tổng như sheet KQua.
Xin cảm ơn.

 

[befaint]

Nhờ các bạn giúp mình lọc và tính tổng như sheet KQua.
Xin cảm ơn.

Pivot table.. 59 giây

 

[huongmuine]

Pivot table.. 59 giây

Cảm ơn bạn đã giúp.

 

[SA_DQ]

Tác giả muốn lập trình thì tham khảo cái ni:

Sub TongHop()
Dim Tmr As Double, fDat As Date, lDat As Date, Dat As Date
Dim SL As Long, Tong As Double, J As Long, W As Integer, Z As Long, Rws As Long
Dim WF As Object, Arr()

Tmr = Timer()
Set WF = Application.WorksheetFunction:     Rws = [b4].CurrentRegion.Rows.Count
lDat = WF.Max([b4].Resize(Rws)):                      fDat = WF.Min([b4].Resize(Rws))
Arr() = [b4].Resize(Rws, 3).Value
ReDim dArr(1 To UBound(Arr()), 1 To 3):         [h5].Resize(Rws, 3).Value = dArr()
For Z = fDat To lDat
    For J = 1 To UBound(Arr())
        If Arr(J, 1) = Z Then
            SL = SL + Arr(J, 2):                        Tong = Tong + Arr(J, 3)
        End If
    Next J
    If SL Then
        W = W + 1:                                      dArr(W, 1) = Z
        dArr(W, 2) = SL:                                SL = 0
        dArr(W, 3) = Tong:                              Tong = 0
    End If
Next Z
If W Then
    [h5].Resize(W, 3).Value = dArr()
End If
[I4].Value = Timer() - Tmr
End Sub

 

[huongmuine]

Tác giả muốn lập trình thì tham khảo cái ni:

Sub TongHop()
Dim Tmr As Double, fDat As Date, lDat As Date, Dat As Date
Dim SL As Long, Tong As Double, J As Long, W As Integer, Z As Long, Rws As Long
Dim WF As Object, Arr()

Tmr = Timer()
Set WF = Application.WorksheetFunction:     Rws = [b4].CurrentRegion.Rows.Count
lDat = WF.Max([b4].Resize(Rws)):                      fDat = WF.Min([b4].Resize(Rws))
Arr() = [b4].Resize(Rws, 3).Value
ReDim dArr(1 To UBound(Arr()), 1 To 3):         [h5].Resize(Rws, 3).Value = dArr()
For Z = fDat To lDat
    For J = 1 To UBound(Arr())
        If Arr(J, 1) = Z Then
            SL = SL + Arr(J, 2):                        Tong = Tong + Arr(J, 3)
        End If
    Next J
    If SL Then
        W = W + 1:                                      dArr(W, 1) = Z
        dArr(W, 2) = SL:                                SL = 0
        dArr(W, 3) = Tong:                              Tong = 0
    End If
Next Z
If W Then
    [h5].Resize(W, 3).Value = dArr()
End If
[I4].Value = Timer() - Tmr
End Sub

Cảm ơn SA_DQ đã giúp.