Tính tổng giữa các khoản trắng

[tuannguyen789]

Hi mọi người,

Tuấn có bài toán theo file đính kèm, nhờ mọi người xem sửa lại chỗ sai giúp. Code chỉ đúng cho tổng lần đầu, các tổng sau sai.

 

[CHAOQUAY]

Hi mọi người,

Tuấn có bài toán theo file đính kèm, nhờ mọi người xem sửa lại chỗ sai giúp. Code chỉ đúng cho tổng lần đầu, các tổng sau sai.

trong file không thấy code nào cả.
Thử cái dưới đây

Sub TINH_TONG()
Dim Nguon
Dim i, k
Nguon = Sheet1.Range("C2:C" & Sheet1.Range("B1000000").End(xlUp).Row)
For i = 1 To UBound(Nguon)
    If Nguon(i, 1) > 0 Then
        k = k + Nguon(i, 1)
    Else
        Sheet1.Range("C" & i + 1) = k
        k = 0
    End If
Next i
End Sub

 

[tuannguyen789]

trong file không thấy code nào cả.
Thử cái dưới đây

Sub TINH_TONG()
Dim Nguon
Dim i, k
Nguon = Sheet1.Range("C2:C" & Sheet1.Range("B1000000").End(xlUp).Row)
For i = 1 To UBound(Nguon)
    If Nguon(i, 1) > 0 Then
        k = k + Nguon(i, 1)
    Else
        Sheet1.Range("C" & i + 1) = k
        k = 0
    End If
Next i
End Sub

Cám ơn CHAOQUAY


Đây là code của Tuấn:

For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
If Range("A" & i).Value = "" Then
Range("C" & i).Value = Application.WorksheetFunction.Sum(Range("C1", Range("C1").End(xlDown)).Rows)
End If
Next

 

[Cu Tồ]

Sub Tinh_Tong()
Dim I&, Lr&, DD%, DC%
With Sheet1
Lr = .Range("C" & Rows.Count).End(xlUp).Row
DD = 2
    For I = 2 To Lr + 1
        If .Range("A" & I).Value = "" Then
                        DC = I - 1
                .Range("C" & I).Value = Application.WorksheetFunction.Sum(.Range("C" & DD, .Range("C" & DC)))
                DD = I + 1
        End If
    Next
End With
End Sub

Code trong file thì sửa vầy

 

[CHAOQUAY]

Cám ơn CHAOQUAY


Đây là code của Tuấn:

For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
If Range("A" & i).Value = "" Then
Range("C" & i).Value = Application.WorksheetFunction.Sum(Range("C1", Range("C1").End(xlDown)).Rows)
End If
Next

Chèn công thức thì thử code này

Sub TINH_TONG()
Dim i, k
With Sheet1
    k = 2
    For i = 2 To .Range("B" & Rows.Count).End(xlUp).Row
        If .Range("C" & i) = "" Then
            .Range("C" & i).FormulaR1C1 = "=SUM(R[" & -(i - k) & "]C:R[-1]C)"
            k = i + 1
        End If
    Next i
End With
End Sub

 

[tuannguyen789]

Sub Tinh_Tong()
Dim I&, Lr&, DD%, DC%
With Sheet1
Lr = .Range("C" & Rows.Count).End(xlUp).Row
DD = 2
    For I = 2 To Lr + 1
        If .Range("A" & I).Value = "" Then
                        DC = I - 1
                .Range("C" & I).Value = Application.WorksheetFunction.Sum(.Range("C" & DD, .Range("C" & DC)))
                DD = I + 1
        End If
    Next
End With
End Sub

Code trong file thì sửa vầy

Cám ơn CuTo,

Code này có khuyết điểm khi dữ liệu cuối trống, nếu bấm nhiều lần vẫn tính, không chốt dữ liệu được

Bài đã được tự động gộp: 11/11/20

Chèn công thức thì thử code này

Sub TINH_TONG()
Dim i, k
With Sheet1
    k = 2
    For i = 2 To .Range("B" & Rows.Count).End(xlUp).Row
        If .Range("C" & i) = "" Then
            .Range("C" & i).FormulaR1C1 = "=SUM(R[" & -(i - k) & "]C:R[-1]C)"
            k = i + 1
        End If
    Next i
End With
End Sub

Cám ơn CHAOQUAY,

Code này thì giống xem ra không ok hơn code ban đầu CHAOQUAY hỗ trợ.
Vì nếu dữ liệu nhiều mà chèn công thức vô sẽ làm nặng file.

Nếu trường hợp vẫn dùng code ban đàu cảu CHAOQUAY, nhưng tính nếu mình bỏ qua phần "thành tiền " chỉ cho hiện tổng thành tiền thành thôi.

tuấn sửa lại code thì khi tính như vậy thì tổng tiền không đúng:

Dim Nguon
Dim i, k
Nguon = Sheet1.Range("A2:B" & Sheet1.Range("B1000000").End(xlUp).Row) '.Resize(, 3)
For i = 1 To UBound(Nguon)
If Nguon(i, 1) > 0 Then
k = k + Nguon(i, 2)
Else
Sheet1.Range("C" & i + 1) = k
'k = 0
End If
Next i

khi đó, tổng đầu thì đúng, nhưng những tổng sau sẽ cộng thêm tổng đầu. Trường hợp này sửa thế nào, nhờ CHAOQUAY hỗ trợ

 

[Cu Tồ]

không chốt dữ liệu được

sửa theo cột C là được

Sub Tinh_Tong1()
Dim I&, Lr&, DD%, DC%
With Sheet1
Lr = .Range("B" & Rows.Count).End(xlUp).Row
DD = 2
    For I = 2 To Lr
        If .Range("c" & I).Value = "" Then
                        DC = I - 1
                .Range("C" & I).Value = Application.WorksheetFunction.Sum(.Range("C" & DD, .Range("C" & DC)))
                DD = I + 1
        End If
    Next
End With
End Sub

 

[Cu Tồ]

nhưng tính nếu mình bỏ qua phần "thành tiền " chỉ cho hiện tổng thành tiền thành thôi

Sub TINH_TONG()
Dim i&, Lr&, DD%, DC%, TC$

With Sheet1
    TC = LCase("t" & ChrW(7893) & "ng" & " " & "c" & ChrW(7897) & "ng")
    TCC = LCase("T" & ChrW(244) & ChrW(777) & "ng c" & ChrW(244) & ChrW(803) & "ng")
    Lr = .Range("B" & Rows.Count).End(xlUp).Row
    DD = 2
            For i = 2 To Lr
                TC2 = LCase(.Range("B" & i).Value)
                If TC2 = TC Or TC2 = TCC Then
                                DC = i - 1
                        .Range("C" & i).Value = Application.WorksheetFunction.Sum(.Range("C" & DD, .Range("C" & DC)))
                        DD = i + 1
                End If
            Next
    End With
End Sub

không thì vầy.khỏi cần quan tâm ô trống hay không,Bên cột B ô nào có chứ "Tổng cộng" thì ở cột C cùng dòng là ô tổng số tiền

 

[Cu Tồ]

chèn công thức vô sẽ làm nặng file

Mảng

Sub TINH_TONG()
Dim i&, DL(), KQ()

With Sheet1
    DL = .Range("A2", .Range("B" & Rows.Count).End(xlUp)).Resize(, 2)
    ReDim KQ(1 To UBound(DL), 1 To 1)
            For i = 1 To UBound(DL)
               If DL(i, 1) <> "" Then
                   KQ(i, 1) = DL(i, 1) * DL(i, 2)
                   k = k + KQ(i, 1)
               Else
                    KQ(i, 1) = k
                    k = 0
               End If
            Next
      .Range("C2").Resize(UBound(DL), 1) = KQ
    End With
End Sub

 

[CHAOQUAY]

Cám ơn CuTo,

Code này có khuyết điểm khi dữ liệu cuối trống, nếu bấm nhiều lần vẫn tính, không chốt dữ liệu được

Bài đã được tự động gộp: 11/11/20

Cám ơn CHAOQUAY,

Code này thì giống xem ra không ok hơn code ban đầu CHAOQUAY hỗ trợ.
Vì nếu dữ liệu nhiều mà chèn công thức vô sẽ làm nặng file.

Nếu trường hợp vẫn dùng code ban đàu cảu CHAOQUAY, nhưng tính nếu mình bỏ qua phần "thành tiền " chỉ cho hiện tổng thành tiền thành thôi.

tuấn sửa lại code thì khi tính như vậy thì tổng tiền không đúng:

Dim Nguon
Dim i, k
Nguon = Sheet1.Range("A2:B" & Sheet1.Range("B1000000").End(xlUp).Row) '.Resize(, 3)
For i = 1 To UBound(Nguon)
If Nguon(i, 1) > 0 Then
k = k + Nguon(i, 2)
Else
Sheet1.Range("C" & i + 1) = k
'k = 0
End If
Next i

khi đó, tổng đầu thì đúng, nhưng những tổng sau sẽ cộng thêm tổng đầu. Trường hợp này sửa thế nào, nhờ CHAOQUAY hỗ trợ

Bạn phải để lệnh k=0 hoạt động thì các kết quả sau sẽ đúng.
Bỏ dấu ' trước k là được

 

[Ba Tê]

Tuấn có bài toán theo file đính kèm, nhờ mọi người xem sửa lại chỗ sai giúp. Code chỉ đúng cho tổng lần đầu, các tổng sau sai.

Thử với Sub này trong Module

Sub TINH_TONG()
Dim Arr(), I As Long, R As Long, Tong As Double
    Arr = Range("B2", Range("B1000000").End(xlUp)).Resize(, 2).Value
    R = UBound(Arr)
For I = 1 To R
    If IsNumeric(Arr(I, 1)) Then
        Tong = Tong + Arr(I, 2)
    Else
        Arr(I, 2) = Tong
        Tong = 0
    End If
Next I
Range("B2").Resize(R, 2) = Arr
End Sub

 

[befaint]

Mod nào đi qua thì chỉnh lại tiêu đề nhé.

 

[Pro speed]

Hi mọi người,

Tuấn có bài toán theo file đính kèm, nhờ mọi người xem sửa lại chỗ sai giúp. Code chỉ đúng cho tổng lần đầu, các tổng sau sai.

Cách 1 cố định

Sub tinhtong()
Range("C5,C9,C13") = "=SUM(R[-3]C:R[-1]C)"
Range("C5,C9,C13").Value = Range("C5,C9,C13").Value
End Sub

Cách 2 nếu muốn Auto

Sub codetinhtong()
For i = 1 To Range("B100000").End(xlUp).Row ' Ban chi cant
    If Range("c" & i) = "" Then
       Range("c" & i) = "=SUM(R[-3]C:R[-1]C)"
       Range("c" & i).Value = Range("c" & i).Value
    End If
Next i
End Sub