Hỏi về cách viết code để tự động tính tổng? (1 người xem)

[ndu96081631]

Cộng các cột tiếp theo trong bảng (File đính kèm bài trên), code cũ tôi chỉ biết làm cho 1 cột vì vậy đang cầu cứu code cộng cho nhiều cột. Bạn giúp tiếp nhé, cảm ơn bạn trước, tôi đang chờ trên máy.

Ẹc... Ẹc... Dạ vâng! Hiểu rồi
Đây nè:

Sub TinhTongConNdu()
  Dim i As Long, j As Long
  With Range([D6], [D65536].End(xlUp))
    For i = 1 To .SpecialCells(4).Areas.Count
      For j = 1 To 18
       .SpecialCells(4).Areas(i).Offset(, j) = WorksheetFunction.Sum(.SpecialCells(2).Areas(i).Offset(, j))
      Next j
    Next
  End With
End Sub

 

[TrungChinhs]

Cảm ơn bạn, kết quả rất tốt. Tôi sẽ nghiên cứu kỹ code này nếu có gì chưa hiểu tôi sẽ nhắn tin riêng cho bạn, bạn vui lòng chỉ giúp nhé.

 

[ndu96081631]

Thật ra tôi còn có tham vọng bỏ bớt 1 vòng lập, như kiểu này đây:

Sub TinhTongConNdu()
  Dim i As Long, SumRng As Range, SumRef As String
  With Range([D6], [D65536].End(xlUp))
    For i = 1 To .SpecialCells(4).Areas.Count
      Set SumRng = .SpecialCells(4).Areas(i).Offset(, 1).Resize(, 18)
      SumRef = .SpecialCells(2).Areas(i).Offset(, 1).Address
      SumRng.FormulaArray = "=SUM(Offset(" & SumRef & ",, TRANSPOSE(ROW(1:18)-1)))"
    Next
  End With
End Sub

Code này rõ ràng chạy nhahh hơn! Nhưng ác 1 cái là:
- Sau khi chạy code xong phải bấm F9 thì nó mới cập nhật đúng (chả lẽ phải thêm Application.SendKeys "{F9}" ...)
- Thứ 2 là chả biết làm cách nào chuyển công thức thành Value
Các bạn thử nghiên cứu xem! ---> Dùng vòng lập For quét qua 18 cell là quá dở

 

[cadafi]

- Thứ 2 là chả biết làm cách nào chuyển công thức thành Value

Anh thử lồng công thức đó vào hàm evaluate() thử xem.

 

[ndu96081631]

Anh thử lồng công thức đó vào hàm evaluate() thử xem.

Lồng thế nào đây Kiệt ơi?
Tôi thử dùng:
SumRng.Value = Evaluate("=SUM(Offset(" & SumRef & ",, TRANSPOSE(ROW(1:18)-1)))")
thì các cell cùng 1 hàng đều cho cùng 1 kết quả

 

[cadafi]

Thôi thì anh xài thử code củ chuối tà đạo này xem có nhanh hơn không? Tuân thủ yêu cầu 1 vòng lặp.

Sub TongConCadafi()
  Dim i As Long, j As Long
  With Range([D6], [D65536].End(xlUp))
    For i = 1 To .SpecialCells(4).Areas.Count
    .SpecialCells(4).Areas(i).Offset(, 1).Resize(, 18).Select
    Selection.FormulaR1C1 = "=SUM(R[1]C:R[" & .SpecialCells(2).Areas(i).Rows.Count & "]C)"
    With Selection
    .Copy: .PasteSpecial Paste:=xlPasteValues
    End With
    Application.CutCopyMode = False
    Next
  End With
End Sub

 

[TrungChinhs]

Cảm ơn Ndu và Ca_Dafi mình đã test thử tất cả code của các bạn, các code đều cho kết quả đúng yêu cầu của bài (mình không biết thử code nào chạy nhanh hay chậm).
Mình đã nghiên cứu code của Ndu để áp dụng cho một bài khác có cấu trúc bảng cộng thêm một cấp so với bài cũ (cộng tiếp các tổng con này thành các tổng con trên 1 cấp) nhưng làm mãi không làm được.
Nhờ các bạn xem giúp code mình sửa (trong file đính kèm) sai ở đâu ? phần giải thích code của Ndu mình hiểu như vậy có đúng không ?

Mong các bạn vui lòng giúp đỡ. Xin cảm ơn !

 

[ndu96081631]

Mình đã nghiên cứu code của Ndu để áp dụng cho một bài khác có cấu trúc bảng cộng thêm một cấp so với bài cũ (cộng tiếp các tổng con này thành các tổng con trên 1 cấp) nhưng làm mãi không làm được.
Nhờ các bạn xem giúp code mình sửa (trong file đính kèm) sai ở đâu ? phần giải thích code của Ndu mình hiểu như vậy có đúng không ?

Mong các bạn vui lòng giúp đỡ. Xin cảm ơn !

Nhìn file thấy hơi rối... Bạn vui lòng giãi thích thêm 1 tí nha:
- Cụ thể sẽ đặt tổng vào cell nào?
- Cell nào là tổng cấp 1, cấp 2?

(mình không biết thử code nào chạy nhanh hay chậm).

Theo tôi, cho đến thời điểm hiện tại thì code cuối cùng của Ca_dafi là ưu việt nhất, vì lý do:
- 1 vòng lập, chỉ quét các cell tính tổng và chỉ quét từ trên xuống, không quét ngang ---> Nên đương nhiên sẽ nhanh hơn quét toàn bộ
- Cái vụ .FormulaR1C1 này có vẽ ngon lành đây (mới biết lần đầu luôn) ---> Tôi nghĩ dù sao nó cũng nhanh hơn là công thức mãng (code của tôi ở trên dùng công thức mãng)
Đã Test thử rồi...

 

[TrungChinhs]

Nhìn file thấy hơi rối... Bạn vui lòng giãi thích thêm 1 tí nha:
- Cụ thể sẽ đặt tổng vào cell nào?
- Cell nào là tổng cấp 1, cấp 2?
...

Cấp 1 là cấp xã ghi ở cột đứng trước - dòng có màu vàng (trong bài không ghi chữ xã)
Cấp 2 là cấp bản - dòng có màu xanh (đã cộng được bằng code của bạn)

 

[TrungChinhs]

Nhìn file thấy hơi rối... Bạn vui lòng giãi thích thêm 1 tí nha:
- Cụ thể sẽ đặt tổng vào cell nào?
- Cell nào là tổng cấp 1, cấp 2?

Theo tôi, cho đến thời điểm hiện tại thì code cuối cùng của Ca_dafi là ưu việt nhất, vì lý do:
- 1 vòng lập, chỉ quét các cell tính tổng và chỉ quét từ trên xuống, không quét ngang ---> Nên đương nhiên sẽ nhanh hơn quét toàn bộ
- Cái vụ .FormulaR1C1 này có vẽ ngon lành đây (mới biết lần đầu luôn) ---> Tôi nghĩ dù sao nó cũng nhanh hơn là công thức mãng (code của tôi ở trên dùng công thức mãng)
Đã Test thử rồi...

Từ gợi ý của Ndu tôi đã xem kỹ lại code của Ca_Dafi và đã phát hiện ra tôi vận dụng sai ở dòng đầu của Range. Giờ thì tôi làm được rồi. Cảm ơn Ndu và Ca_Dafi rất nhiều !

Sub TongConCadafi()
      With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False

'Cong ban (cap2)
  Dim i As Long, j As Long
  With Range([E6], [E65536].End(xlUp))
    For i = 1 To .SpecialCells(4).Areas.Count
        .SpecialCells(4).Areas(i).Offset(, 2).Resize(, 10).Select
        Selection.FormulaR1C1 = "=SUM(R[1]C:R[" & .SpecialCells(2).Areas(i).Rows.Count & "]C)"
        With Selection
    .Copy: .PasteSpecial Paste:=xlPasteValues
    End With
    Application.CutCopyMode = False
    Next
  End With

'cong xa (cap1)
  With Range("C8:C" & [E65536].End(xlUp).Row)
    For i = 1 To .SpecialCells(2).Areas.Count
        .SpecialCells(2).Areas(i).Offset(, 4).Resize(, 14).Select
        Selection.FormulaR1C1 = "=SUM(R[1]C:R[" & .SpecialCells(4).Areas(i).Rows.Count & "]C)/2"
    With Selection
    .Copy: .PasteSpecial Paste:=xlPasteValues
    End With
    Application.CutCopyMode = False
    Next
 End With
    [E7].Select
        
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
End With
End Sub

 

[Mr Okebab]

Thôi thì anh xài thử code củ chuối tà đạo này xem có nhanh hơn không? Tuân thủ yêu cầu 1 vòng lặp.

Sub TongConCadafi()
  Dim i As Long, j As Long
  With Range([D6], [D65536].End(xlUp))
    For i = 1 To .SpecialCells(4).Areas.Count
    .SpecialCells(4).Areas(i).Offset(, 1).Resize(, 18).Select
    Selection.FormulaR1C1 = "=SUM(R[1]C:R[" & .SpecialCells(2).Areas(i).Rows.Count & "]C)"
    With Selection
    .Copy: .PasteSpecial Paste:=xlPasteValues
    End With
    Application.CutCopyMode = False
    Next
  End With
End Sub

Có thể thay :

    With Selection
    .Copy: .PasteSpecial Paste:=xlPasteValues
    End With

Bằng :

    With Selection
         .Value = .Value
     End With

[/php]

Thân!

 

[TrungChinhs]

Sub TongCon()
  Dim i As Long, j As Long
  With Range([D6], [D65536].End(xlUp))
    For i = 1 To .SpecialCells(4).Areas.Count

'Cộng vùng 1   
 .SpecialCells(4).Areas(i).Offset(, 1).Resize(, 18).Select
    Selection.FormulaR1C1 = "=SUM(R[1]C:R[" & .SpecialCells(2).Areas(i).Rows.Count & "]C)"

'Cộng vùng 2    
    .SpecialCells(4).Areas(i).Offset(, 21).Resize(, 5).Select
    Selection.FormulaR1C1 = "=SUM(R[1]C:R[" & .SpecialCells(2).Areas(i).Rows.Count & "]C)"
    
    With Selection
         .Value = .Value
     End With  
    Next
  End With
End Sub

Khi cộng các vùng cột không liên tục thì sửa code này như thế nào ?
Nhờ các bạn sửa giúp. Thank !

 

[tri_0988176716]

Bạn ơi! Mình cần đoạn code cửa bạn nói đó. Vì mình cũng gặp vướng mắt khi Sum trong bảng tiên lượng dự toán đó. Làm sao Sum được các cột KL chi tiét. Code của bạn đâu cho mình với. Mình muốn cột Sum tổng tự động cộng các giá trị của cột KL chi tiết khi gạp mã hiệu khác thì tự động dừng ngay hàng mã hiệu đó.