Cần giúp tính tổng Subtotal theo tiêu chí thỏa mãn 2 cột (Dùng cho Excel 2003) (1 người xem)

[hung2412]

Xin chào các Anh chị và các bạn GPE!
Nhờ các Anh chị và các bạn giúp đỡ cho tôi vấn đề này với, cụ thể như sau:
Tôi có 1 bảng tính như vầy:

Hàm Subtotal trên thanh công cụ Excel (Data => Subtotal) tính tổng theo tiêu chí của một cột cụ thể (Ví dụ theo tiêu chí cột A để tính tổng cột F và cột G) => Vậy để tính tổng như Subtotal như vậy nhưng theo tiêu chí đồng thời 2 cột (Theo tiêu chí cột A và cột B để tính tổng cột F và cột G) thì làm cách nào?. Kết quả mong muốn như hình dưới đây (Tôi xài Excel 2003):

Mong các Anh chị và các bạn GPE chỉ giáo!
Trân trọng cảm ơn!
P/s: Có 01 File đính kèm.

 

[Ba Tê]

Xin chào các Anh chị và các bạn GPE!
Nhờ các Anh chị và các bạn giúp đỡ cho tôi vấn đề này với, cụ thể như sau:
Tôi có 1 bảng tính như vầy:

Hàm Subtotal trên thanh công cụ Excel (Data => Subtotal) tính tổng theo tiêu chí của một cột cụ thể (Ví dụ theo tiêu chí cột A để tính tổng cột F và cột G) => Vậy để tính tổng như Subtotal như vậy nhưng theo tiêu chí đồng thời 2 cột (Theo tiêu chí cột A và cột B để tính tổng cột F và cột G) thì làm cách nào?. Kết quả mong muốn như hình dưới đây (Tôi xài Excel 2003):

Mong các Anh chị và các bạn GPE chỉ giáo!
Trân trọng cảm ơn!
P/s: Có 01 File đính kèm.

Tạo thêm 1 sheet đặt tên là GPE rồi thử code này coi sao

Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, Tem As String, Tong(1 To 1, 1 To 2)
With Sheet1
    sArr = .Range(.[A8], .[A8].End(xlDown).Offset(1)).Resize(, 8).Value
End With
ReDim dArr(1 To UBound(sArr, 1) * 2, 1 To 8)
For I = 1 To UBound(sArr, 1) - 1
    K = K + 1
    For J = 1 To 8
        dArr(K, J) = sArr(I, J)
    Next J
    Tong(1, 1) = Tong(1, 1) + sArr(I, 6)
    Tong(1, 2) = Tong(1, 2) + sArr(I, 7)
    If sArr(I, 1) & "#" & sArr(I, 2) <> sArr(I + 1, 1) & "#" & sArr(I + 1, 2) Then
        K = K + 1
        dArr(K, 1) = sArr(I, 1) & " Total"
        dArr(K, 6) = Tong(1, 1): Tong(1, 1) = 0
        dArr(K, 7) = Tong(1, 2): Tong(1, 2) = 0
    End If
Next I
With Sheets("GPE")
    .[A8].Resize(K, 8) = dArr
End With
End Sub

 

[hung2412]

Tạo thêm 1 sheet đặt tên là GPE rồi thử code này coi sao

Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, Tem As String, Tong(1 To 1, 1 To 2)
With Sheet1
    sArr = .Range(.[A8], .[A8].End(xlDown).Offset(1)).Resize(, 8).Value
End With
ReDim dArr(1 To UBound(sArr, 1) * 2, 1 To 8)
For I = 1 To UBound(sArr, 1) - 1
    K = K + 1
    For J = 1 To 8
        dArr(K, J) = sArr(I, J)
    Next J
    Tong(1, 1) = Tong(1, 1) + sArr(I, 6)
    Tong(1, 2) = Tong(1, 2) + sArr(I, 7)
    If sArr(I, 1) & "#" & sArr(I, 2) <> sArr(I + 1, 1) & "#" & sArr(I + 1, 2) Then
        K = K + 1
        dArr(K, 1) = sArr(I, 1) & " Total"
        dArr(K, 6) = Tong(1, 1): Tong(1, 1) = 0
        dArr(K, 7) = Tong(1, 2): Tong(1, 2) = 0
    End If
Next I
With Sheets("GPE")
    .[A8].Resize(K, 8) = dArr
End With
End Sub

Vâng, anh đã làm đúng theo ý em. Tuy nhiên, em muốn để dạng công thức Subtotal (Không phải số chết) có được không ạ? (Mục đích để cho các vị khác tiện kiểm tra cho nhanh ạ)

 

[Ba Tê]

Vâng, anh đã làm đúng theo ý em. Tuy nhiên, em muốn để dạng công thức Subtotal (Không phải số chết) có được không ạ? (Mục đích để cho các vị khác tiện kiểm tra cho nhanh ạ)

Xài tạm hàm SUM() đi. Muốn hàm khác thì tự sửa.

Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, Rws As Long
With Sheet1
    sArr = .Range(.[A8], .[A8].End(xlDown).Offset(1)).Resize(, 8).Value
End With
Rws = 8
ReDim dArr(1 To UBound(sArr, 1) * 2, 1 To 8)
For I = 1 To UBound(sArr, 1) - 1
    K = K + 1
    For J = 1 To 8
        dArr(K, J) = sArr(I, J)
    Next J
    If sArr(I, 1) & "#" & sArr(I, 2) <> sArr(I + 1, 1) & "#" & sArr(I + 1, 2) Then
        K = K + 1
        dArr(K, 1) = sArr(I, 1) & " Total"
        dArr(K, 6) = "=SUM(R" & Rws & "C:R[-1]C)"
        dArr(K, 7) = "=SUM(R" & Rws & "C:R[-1]C)"
        Rws = K + 8
    End If
Next I
With Sheets("GPE")
    .[A8].Resize(K, 8) = dArr
End With
End Sub