Cần giúp đỡ về tính tổng theo điều kiện và tạo nhóm cho dòng (1 người xem)

[asian4you]

Chào các bác, em có 1 file như ở dưới đây các bác giúp em tạo macro như sau:
1. Em cần gộp những dòng không in đậm vào 1 nhóm, như từ dòng 4-6; 8-11; 13-15
2. Ở những dòng in đậm như dòng 3 thì từ ô C3 đến ô n3 em muốn có công thức tính tổng những ô trong cùng cột không được in đậm. Như ô C3 tổng của C4:C6; D4 là tổng của D46. Ở dòng 7 hay 12 cũng tương tự ạ C7 là tổng của C8:C11.
Em cám ơn trước

 

[HieuCD]

Chào các bác, em có 1 file như ở dưới đây các bác giúp em tạo macro như sau:
1. Em cần gộp những dòng không in đậm vào 1 nhóm, như từ dòng 4-6; 8-11; 13-15
2. Ở những dòng in đậm như dòng 3 thì từ ô C3 đến ô n3 em muốn có công thức tính tổng những ô trong cùng cột không được in đậm. Như ô C3 tổng của C4:C6; D4 là tổng của D46. Ở dòng 7 hay 12 cũng tương tự ạ C7 là tổng của C8:C11.
Em cám ơn trước

C2 =SUBTOTAL(9,OFFSET(C3,,,IFERROR(MATCH("?*",$A3:$A$18,0)-1,ROWS($A3:$A$18))))

C3 =SUBTOTAL(9,OFFSET(C4,,,IFERROR(INDEX(MATCH("?*",$A4:$A$18&"",0)-1,),ROWS($A4:$A$18))))

Copy từng ô và dán vào vùng dữ liệu tương ứng

 

[SA_DQ]

Bạn cần công thức, nhưng lại đưa bài vô ngăn lập trình là sao vậy?

 

[asian4you]

C2 =SUBTOTAL(9,OFFSET(C3,,,IFERROR(MATCH("?*",$A3:$A$18,0)-1,ROWS($A3:$A$18))))

C3 =SUBTOTAL(9,OFFSET(C4,,,IFERROR(INDEX(MATCH("?*",$A4:$A$18&"",0)-1,),ROWS($A4:$A$18))))

Copy từng ô và dán vào vùng dữ liệu tương ứng

Cám ơn bác nhưng có cách nào tạo 1 macro được không ạ, nếu cần điều kiện nữa thì có thể căn cứ vào dữ liệu cột A với các ký tự số hoặc chữ kia ạ.
ở ô C của dòng có số ở đầu ví dụ như ô C3 (của dòng 3 thì ở ô A3 có số 3) sẽ là tổng của các ô ở cột C liền kề tới dòng 7 có số 2 ở ô A7

Bạn cần công thức, nhưng lại đưa bài vô ngăn lập trình là sao vậy?

Thì em đang cần lập trình macro mà bác

 

[hungvinh1402]

Hi vọng đúng ý bạn

Sub SumAndGroup()
    Dim iLop As Integer, jCot As Integer, kTo As Integer, n As Integer, Lr As Integer, Lcol As Integer
    Dim Arr(), Diem_Lop As Long, Diem_To As Long
    reset  ' Xoa du lieu cu
    With Sheet1
        Lr = .Range("B" & Rows.Count).End(xlUp).Row
        Lcol = .Cells(6, Columns.Count).End(xlToLeft).Column
        Arr = .Range("A2").Resize(Lr - 1, Lcol).Value
    End With
    '-------------------------------------------------------------------
    For jCot = 3 To UBound(Arr, 2)
        For iLop = 1 To UBound(Arr, 1) - 2
            If WorksheetFunction.IsText(Arr(iLop, 1)) Then
                For kTo = iLop + 1 To UBound(Arr, 1) - 1
                    If IsNumeric(Arr(kTo, 1)) And Arr(kTo, 1) <> "" Then
                        For n = kTo + 1 To UBound(Arr, 1)
                            If Arr(n, 1) = "" Then
                                Diem_To = Diem_To + Arr(n, jCot)
                            ElseIf IsNumeric(Arr(n, 1)) Then
                                Arr(kTo, jCot) = Diem_To
                                Diem_Lop = Diem_Lop + Diem_To
                                Diem_To = 0
                                Exit For
                            Else
                                Arr(kTo, jCot) = Diem_To
                                Diem_Lop = Diem_Lop + Diem_To
                                Diem_To = 0
                                Arr(iLop, jCot) = Diem_Lop
                                Diem_Lop = 0
                                Exit For
                            End If
                        Next n
                    End If
                    If n > UBound(Arr, 1) Then
                        Arr(kTo, jCot) = Diem_To
                        Diem_Lop = Diem_Lop + Diem_To
                        Diem_To = 0
                        Arr(iLop, jCot) = Diem_Lop
                        Diem_Lop = 0
                        Exit For
                    End If
                    If IsNumeric(Arr(n, 1)) And Arr(n, 1) <> "" Then
                            kTo = n - 1
                        Else
                            iLop = n - 1
                            Exit For
                    End If
                Next kTo
            End If
        Next iLop
    Next jCot
    Sheet1.Range("A2").Resize(Lr - 1, Lcol) = Arr
    '----------------------------------------------------------
    ' To mau, group
    For iLop = 1 To Lr
        With Sheet1
            If WorksheetFunction.IsText(.Range("A" & iLop)) Then
                With .Range("A" & iLop).Resize(, Lcol).Interior
                    .ThemeColor = xlThemeColorAccent3
                    .TintAndShade = 0.599993896298105
                End With
            ElseIf IsNumeric(.Range("A" & iLop)) And .Range("A" & iLop) <> "" Then
                With .Range("A" & iLop).Resize(, Lcol).Interior
                    .ThemeColor = xlThemeColorAccent5
                    .TintAndShade = 0.799981688894314
                End With
                For kTo = iLop + 1 To Lr
                    If IsNumeric(.Range("A" & kTo)) And .Range("A" & kTo) <> "" Or WorksheetFunction.IsText(.Range("A" & kTo)) Then
                        .Range(.Cells(iLop + 1, 1), .Cells(kTo - 1, 1)).Rows.Group
                        iLop = kTo - 1
                        Exit For
                    End If
                Next kTo
            End If
        End With
    Next iLop
    MsgBox "Done", , "TuhocVBA.net"
End Sub

 

[Ba Tê]

Chào các bác, em có 1 file như ở dưới đây các bác giúp em tạo macro như sau:
1. Em cần gộp những dòng không in đậm vào 1 nhóm, như từ dòng 4-6; 8-11; 13-15
2. Ở những dòng in đậm như dòng 3 thì từ ô C3 đến ô n3 em muốn có công thức tính tổng những ô trong cùng cột không được in đậm. Như ô C3 tổng của C4:C6; D4 là tổng của D46. Ở dòng 7 hay 12 cũng tương tự ạ C7 là tổng của C8:C11.
Em cám ơn trước

Với yêu cầu và File như bài #1, bạn thử Sub này xem sao.

Option Explicit

Public Sub s_Gpe()
Const CoL As Long = 11  '--------------So Cot cua Bang du lieu'
Dim Rng As Range, I As Long, R As Long, K1 As Long, K2 As Long
Set Rng = Range("A2", Range("B1000").End(xlUp)).Resize(, CoL)
    R = Rng.Rows.Count
    For I = R To 1 Step -1
        If Rng(I, 1) = Empty Then
            K1 = K1 + 1:    K2 = K2 + 1
        ElseIf IsNumeric(Rng(I, 1)) Then
            Rng(I, 3).Resize(, CoL - 2) = "=SUM(R[1]C:R[" & K1 & "]C)"
            K1 = 0:         K2 = K2 + 1
        Else
            Rng(I, 3).Resize(, CoL - 2) = "=SUM(R[1]C:R[" & K2 & "]C)/2"
            K1 = 0:         K2 = 0
        End If
    Next I
End Sub