Nhờ các thầy cô anh chị giúp em cái Macro hàm Sum này với! (1 người xem)

[Hong.Van]

Chào các thầy cô & anh chị!
Em là người mới tham gia diễn đàn GPE, nên nhiều cái chưa rõ
Em có Recorder Macro nhưng không hiểu, Các anh chị giúp em một tay nha!
Có giải thích trong File đính kèm!
Xin cảm ơn các thầy cô, anh chị.

 

[Ba Tê]

Chào các thầy cô & anh chị!
Em là người mới tham gia diễn đàn GPE, nên nhiều cái chưa rõ
Em có Recorder Macro nhưng không hiểu, Các anh chị giúp em một tay nha!
Có giải thích trong File đính kèm!
Xin cảm ơn các thầy cô, anh chị.

Hổng biết gán giá trị hay gán công thức.
Gán "thí" công thức như file mẫu vậy.

 

[concogia]

Chào các thầy cô & anh chị!
Em là người mới tham gia diễn đàn GPE, nên nhiều cái chưa rõ
Em có Recorder Macro nhưng không hiểu, Các anh chị giúp em một tay nha!
Có giải thích trong File đính kèm!
Xin cảm ơn các thầy cô, anh chị.

Nếu cấu trúc dữ liệu đúng như trong bài thì thêm một cách "nhảy cà tưng" từ trên xuống dưới

Public Sub TongCon()
    Dim iDau, iCuoi, VungTong, Thoat, I
        Thoat = [A10000].End(xlUp).Row
        Set iDau = Range("A9").Offset(1)
            Do
                iCuoi = iDau.End(xlDown).Row
                Set VungTong = Range(iDau, iDau.End(xlDown))
                    For I = 4 To 6
                        iDau.Offset(-1, I) = Application.WorksheetFunction.Sum(VungTong.Offset(, I))
                    Next I
                If iCuoi = Thoat Then Exit Do
                Set iDau = Cells(iCuoi + 3, 1)
            Loop
End Sub

Ba Tê lúc này chơi mảng hông há

 

[Hong.Van]

Nếu cấu trúc dữ liệu đúng như trong bài thì thêm một cách

Các thầy cho em hỏi, nếu phát sinh thêm dòng thì chỉ Code như thế nào?
Em cảm ơn hai thầy.

 

[concogia]

Các thầy cho em hỏi, nếu phát sinh thêm dòng thì chỉ Code như thế nào?
Em cảm ơn hai thầy.

Với code bài của mình & nếu cấu trúc bảng của bạn đúng như trong bài, bạn có thể thêm được khoảng 9 ngàn 900 dòng thôi
Mà sao bạn không thử thêm nhỉ
Thân

 

[Hong.Van]

Với code bài của mình & nếu cấu trúc bảng của bạn đúng như trong bài, bạn có thể thêm được khoảng 9 ngàn 900 dòng thôi
Mà sao bạn không thử thêm nhỉ
Thân

Tại em cứ nghĩ các thầy lất cột B làm chuẩn, không thêm các STT, nên vô tình code chạy sai
Xin cảm ơn thầy cô!

 

[Ba Tê]

...........
Ba Tê lúc này chơi mảng hông há

Oan cho em quá Cò ơi, Sub này nó "nhảy cà giựt" từ dòng 1000 trở lên, thấy có mảng nào đâu Trời.

Public Sub GPE()
Dim N As Long, Tem1 As Variant, Tem2 As Variant, Tem3 As Variant, I As Long
    N = Sheets("An").[C1000].End(xlUp).Row
    For I = N + 1 To 9 Step -1
        If Cells(I, 2) = "" And Cells(I, 3) = "" Then
            Tem1 = Cells(I - 1, 5).Address: Tem2 = Cells(I - 1, 6).Address: Tem3 = Cells(I - 1, 7).Address
        ElseIf Cells(I, 2) = "" And Cells(I, 3) <> "" Then
            Cells(I, 5).Value = "=sum(" & Cells(I + 1, 5).Address & ":" & Tem1 & ")"
            Cells(I, 6).Value = "=sum(" & Cells(I + 1, 6).Address & ":" & Tem2 & ")"
            Cells(I, 7).Value = "=sum(" & Cells(I + 1, 7).Address & ":" & Tem3 & ")"
        End If
    Next I
End Sub

 

[hoangvuluan]

Hàm aSubTotal - dùng chức năng thống kê tương tự SubTotal của Excel

Bạn thử dùng thử hàm aSubTotal như dưới đây xem sao nhé:

Function aSubTotal(o As Byte, Optional nF As Byte = 9) As Variant
' Huong: o = 1 -> up | o =2 -> down  : SubTotal
'            o = 11, 12 :  SubTotal All for up, down
'            cac truong hop con lai : SubTotal All for down
' Tuy chon nF : cac gia tri xac dinh ham thong ke SubTotal cua Excel
'               mac dinh gia tri 9 la ham SUM, 109 la SUM bo qua cac gia tri bi che (hidden) ...
' Ham aSubTotal cho phep thong ke = tuong tu chuc nang SubTotal cua Excel

Const sF = "=ASUBTOTAL"
Dim sh As Worksheet
Dim ra As Range, r1 As Range
Dim ce As Range
Dim sRo As Long, eRo As Long, sCo As Long, eCo As Long, Ori As Long
Dim i As Long, k As Long, have As Boolean
    Application.Volatile
    aSubTotal = ""
    On Error Resume Next
    Set ce = Application.Caller
    If Err.Number <> 0 Then Exit Function
    On Error GoTo 0
    If (o Mod 10) = 0 Then
        Exit Function
    End If
    Set sh = ActiveSheet
    sRo = ce.Row: sCo = ce.Column
    
    Set r1 = sh.Cells(sh.Rows.Count, sCo).End(xlUp)
   
    Select Case (o Mod 10)
        Case 1                      ' for up '
            Ori = -1
            eRo = 1
            eCo = 0
        Case 2                      ' for down '
            Ori = 1
            eRo = r1.Row
            eCo = 0
        Case Else                   ' for down -> default '
            Ori = 1
            eRo = r1.Row
            eCo = 0
    End Select
    If o < 10 Then ' Tinh SubTotal up/down cho den khi gap 1 aSubTotal khac thi dung lai '
        have = False
            k = 1
            For i = sRo + Ori To eRo Step Ori
                If UCase(Left(ce.Offset(k * Ori, eCo).Formula & "", Len(sF))) = sF Then
                    eRo = i
                    have = True
                    Exit For
                End If
                k = k + 1
            Next
            If (have) Then eRo = eRo - Ori
            Set ra = sh.Range(Cells(sRo + Ori, sCo), Cells(eRo, sCo))
        aSubTotal = WorksheetFunction.Subtotal(nF, ra)
    
    Else ' if o > 10 -> Tinh SubTotal All '
        sRo = ce.Row: sCo = ce.Column
        Set ra = sh.Range(sh.Cells(sRo + Ori, sCo), sh.Cells(eRo, sCo))
            k = 1
            Set r1 = Nothing
            For i = 1 To ra.Rows.Count
                If (UCase(Left(ra.Cells(i, 1).Formula & "", Len(sF))) = sF) And (i > k) Then
                    If r1 Is Nothing Then
                        Set r1 = sh.Range(ra.Cells(k, 1), ra.Cells(i - 1, 1))
                    Else
                        Set r1 = Application.Union(r1, sh.Range(ra.Cells(k, 1), ra.Cells(i - 1, 1)))
                    End If
                    k = i + 1
                End If
            Next
            If k < ra.Rows.Count Then Set r1 = Application.Union(r1, sh.Range(ra.Cells(k, 1), ra.Cells(i - 1, 1)))
        aSubTotal = WorksheetFunction.Subtotal(nF, r1)
    End If
    Set sh = Nothing:     Set ra = Nothing:    Set r1 = Nothing
End Function

Trong VBAProject, tạo 1 Modules, và copy hàm ở trên vào, sau đó sử dùng hàm này bình thường như các hàm của Excel.
(Xem file đính kèm)

 

[Hong.Van]

Bạn thử dùng thử hàm aSubTotal như dưới đây xem sao nhé:

Trong VBAProject, tạo 1 Modules, và copy hàm ở trên vào, sau đó sử dùng hàm này bình thường như các hàm của Excel.
(Xem file đính kèm)

Em cảm ơn thầy!
Cho em hỏi thủ tục chuyển một hàm tự tạo thành Addin.
Nếu các thầy cô biết nằm ở bài nào thì chỉ giúp em!