Tính toán dữ liệu khi lọc bằng VBA

[ndphongskr]

Chào các bác ạ, chả là mình có 1 bảng tính rất nhiều dữ liệu, hiện tại mình đang làm tính toán bằng VBA cho nó nhẹ ko phải dùng công thức như sau ạ:

Sub Calculate()

On Error Resume Next

ActiveSheet.ShowAllData

Dim lastRow As Long

lastRow = Cells(Rows.Count, "A").End(xlUp).Row

With Range(Cells(2, "L"), Cells(lastRow, "L"))
.Formula = "=IFERROR(H2-SUM(I2:K2),"""")"
.Value = .Value
End With
End Sub

Hiện tại theo code trên thì chỉ show all dữ liệu ra thì khi calculate nó mới đúng còn khi lọc dữ liệu thì sẽ chạy tùm lum hết. nên nó bất tiện khi đang nhập dữ liệu muốn tính toán lại phải show all ra rồi tính xong mình lại phải lọc lại dữ liệu để kiểm tra. Vậy làm phiền các bác cho mình hỏi là có code nào mà tính toán dữ liệu của bảng khi đang lọc không ạ. Cám ơn các bác.

 

[Nhattanktnn]

Chào các bác ạ, chả là mình có 1 bảng tính rất nhiều dữ liệu, hiện tại mình đang làm tính toán bằng VBA cho nó nhẹ ko phải dùng công thức như sau ạ:

Sub Calculate()

On Error Resume Next

ActiveSheet.ShowAllData

Dim lastRow As Long

lastRow = Cells(Rows.Count, "A").End(xlUp).Row

With Range(Cells(2, "L"), Cells(lastRow, "L"))
.Formula = "=IFERROR(H2-SUM(I2:K2),"""")"
.Value = .Value
End With
End Sub

Hiện tại theo code trên thì chỉ show all dữ liệu ra thì khi calculate nó mới đúng còn khi lọc dữ liệu thì sẽ chạy tùm lum hết. nên nó bất tiện khi đang nhập dữ liệu muốn tính toán lại phải show all ra rồi tính xong mình lại phải lọc lại dữ liệu để kiểm tra. Vậy làm phiền các bác cho mình hỏi là có code nào mà tính toán dữ liệu của bảng khi đang lọc không ạ. Cám ơn các bác.

Sửa code .

Sub Calculate()
    Dim Lr As Long, Rng As Range, Cll As Range, R As Long
    With Sheets("Sheet1")
        Lr = .Cells(Rows.Count, "A").End(xlUp).Row
        If Lr = 1 Then Exit Sub
        Set Rng = .Range("L2:L" & Lr).SpecialCells(xlCellTypeVisible)
        For Each Cll In Rng
            R = Cll.Row
            Cll.Value = .Cells(R, "H") - Application.Sum(Range(.Cells(R, "I"), .Cells(R, "K")))
        Next
    End With
End Sub

 

[ndphongskr]

Sửa code .

Sub Calculate()
    Dim Lr As Long, Rng As Range, Cll As Range, R As Long
    With Sheets("Sheet1")
        Lr = .Cells(Rows.Count, "A").End(xlUp).Row
        If Lr = 1 Then Exit Sub
        Set Rng = .Range("L2:L" & Lr).SpecialCells(xlCellTypeVisible)
        For Each Cll In Rng
            R = Cll.Row
            Cll.Value = .Cells(R, "H") - Application.Sum(Range(.Cells(R, "I"), .Cells(R, "K")))
        Next
    End With
End Sub

Cám ơn bác nhiều nha, mấy file nhẹ nhẹ thì mình sử dùng rất tuyệt vời. Mấy file nặng tầm cỡ vài chục nghìn dòng thì khi sử dụng nó xoay hơi lâu bác ạ.

 

[Nhattanktnn]

Cám ơn bác nhiều nha, mấy file nhẹ nhẹ thì mình sử dùng rất tuyệt vời. Mấy file nặng tầm cỡ vài chục nghìn dòng thì khi sử dụng nó xoay hơi lâu bác ạ.

Bạn thêm dòng tắt tính toán tự động rồi chạy xong code bật lại xem sao?
Nếu dữ liệu lớn thì thực hiện bằng mảng

 

[ndphongskr]

Bạn thêm dòng tắt tính toán tự động rồi chạy xong code bật lại xem sao?
Nếu dữ liệu lớn thì thực hiện bằng mảng

cám ơn bác, để mình thử

 

[VetMini]

...
Nếu dữ liệu lớn thì thực hiện bằng mảng

Vì mỗi con tính lại phải tính SUM cả cụm.
Nếu code vòng lặp thì tính SUM theo lũy tiến hiệu quả hơn.

 

[huhumalu]

Cám ơn bác nhiều nha, mấy file nhẹ nhẹ thì mình sử dùng rất tuyệt vời. Mấy file nặng tầm cỡ vài chục nghìn dòng thì khi sử dụng nó xoay hơi lâu bác ạ.

Sub Con()
Dim lastRow As Long
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
 
        Range("L2:L" & lastRow).FormulaR1C1 = "=IFERROR(RC[-4]-SUM(RC[-3]:RC[-1]),"""""""")"
 
    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
    If Not Application.CalculationState = xlDone Then
        DoEvents
    End If
 
        Range("L2:L" & lastRow).Value = Range("L2:L" & lastRow).Value
 
End Sub

Bạn xem thử, theo cách của bạn.
P/s:
Mà đằng nào cũng lấy kết quả, bạn có thể nạp cả cụm vào mảng, tính toán, xong hết rồi mới trả lại bảng tính, như vậy sẽ nhanh hơn rất nhiều.

Sub Concon()
Dim lastRow As Long
Dim Arr
Dim kq
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
        Range("L2:L" & lastRow).ClearContents
        Arr = Range("H2:L" & lastRow)
        ReDim kq(1 To UBound(Arr))
        For i = 1 To UBound(Arr)
            If Arr(i, 1) <> "" Then
                kq(i) = Arr(i, 1) - Arr(i, 2) - Arr(i, 3) - Arr(i, 4)
            End If
        Next
    Range("L2").Resize(UBound(Arr)) = WorksheetFunction.Transpose(kq)
End Sub

 

[ndphongskr]

Bạn thêm dòng tắt tính toán tự động rồi chạy xong code bật lại xem sao?
Nếu dữ liệu lớn thì thực hiện bằng mảng

Có phải thêm như này ko bác?

Sub Calculate()
Dim Lr As Long, Rng As Range, Cll As Range, R As Long
Application.Calculation = xlManual
With Sheets("Sheet1")
Lr = .Cells(Rows.Count, "A").End(xlUp).Row
If Lr = 1 Then Exit Sub
Set Rng = .Range("L2:L" & Lr).SpecialCells(xlCellTypeVisible)
For Each Cll In Rng
R = Cll.Row
Cll.Value = .Cells(R, "H") - Application.Sum(Range(.Cells(R, "I"), .Cells(R, "K")))
Next
End With
Application.Calculation = xlAutomatic
End Sub

mình thêm vào như này thì thấy chạy nhanh hơn hẳn bác ạ.

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

Sub Con()
Dim lastRow As Long
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
 
        Range("L2:L" & lastRow).FormulaR1C1 = "=IFERROR(RC[-4]-SUM(RC[-3]:RC[-1]),"""""""")"
 
    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
    If Not Application.CalculationState = xlDone Then
        DoEvents
    End If
 
        Range("L2:L" & lastRow).Value = Range("L2:L" & lastRow).Value
 
End Sub

Bạn xem thử, theo cách của bạn.
P/s:
Mà đằng nào cũng lấy kết quả, bạn có thể nạp cả cụm vào mảng, tính toán, xong hết rồi mới trả lại bảng tính, như vậy sẽ nhanh hơn rất nhiều.

Sub Concon()
Dim lastRow As Long
Dim Arr
Dim kq
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
        Range("L2:L" & lastRow).ClearContents
        Arr = Range("H2:L" & lastRow)
        ReDim kq(1 To UBound(Arr))
        For i = 1 To UBound(Arr)
            If Arr(i, 1) <> "" Then
                kq(i) = Arr(i, 1) - Arr(i, 2) - Arr(i, 3) - Arr(i, 4)
            End If
        Next
    Range("L2").Resize(UBound(Arr)) = WorksheetFunction.Transpose(kq)
End Sub

mình thử cách của bác thì khi lọc dữ liệu thì lại ko tính đúng

 

[VetMini]

...
Mà đằng nào cũng lấy kết quả, bạn có thể nạp cả cụm vào mảng, tính toán, xong hết rồi mới trả lại bảng tính, như vậy sẽ nhanh hơn rất nhiều.

Ở bài #6 tôi nói cộng lũy tiến là do nhìn lầm cái tổng. Té ra là chỉ có tổng một vài cột vào cột kết quả.

Dạng bài này là điển hình của mẹo dùng hàm Evaluate để đi tắt qua vòng lặp.
Tôi có từng chỉ dẫn cách này cách đây ít lâu. Nếu bạn muốn tìm hiểu.

 

[huhumalu]

Ở bài #6 tôi nói cộng lũy tiến là do nhìn lầm cái tổng. Té ra là chỉ có tổng một vài cột vào cột kết quả.

Dạng bài này là điển hình của mẹo dùng hàm Evaluate để đi tắt qua vòng lặp.
Tôi có từng chỉ dẫn cách này cách đây ít lâu. Nếu bạn muốn tìm hiểu.

Dạ, em chưa biết dùng, nhờ anh mách thêm mẹo dùng Evaluate, mà không cần dùng vòng lặp.

 

[snow25]

Ở bài #6 tôi nói cộng lũy tiến là do nhìn lầm cái tổng. Té ra là chỉ có tổng một vài cột vào cột kết quả.

Dạng bài này là điển hình của mẹo dùng hàm Evaluate để đi tắt qua vòng lặp.
Tôi có từng chỉ dẫn cách này cách đây ít lâu. Nếu bạn muốn tìm hiểu.

Anh ơi em đang thấy nếu để lọc Filter thì khi Bỏ tích ở cuối Filter thì xác định dòng cuối của dữ liệu bị thiếu.Có cách nào xác định dòng cuối không anh.

 

[huhumalu]

Anh ơi em đang thấy nếu để lọc Filter thì khi Bỏ tích ở cuối Filter thì xác định dòng cuối của dữ liệu bị thiếu.Có cách nào xác định dòng cuối không anh.

Thử cách này xem.

Set WB = Sheets("Sheet1")
Set FilterRgn = WB.AutoFilter.Range
   lastRowRgn = FilterRgn.Cells(1).Row + FilterRgn.Rows.Count
   lastRow = WB.Cells(Rows.Count, "A").End(xlUp).Row
   If lastRow < lastRowRgn Then lastRow = lastRowRgn

 

[VetMini]

Dạ, em chưa biết dùng, nhờ anh mách thêm mẹo dùng Evaluate, mà không cần dùng vòng lặp.

Sub Con()
Dim lastRow As Long
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("L2:L" & lastRow) = Evaluate("=" & "$H$2:$H$" & lastRow _
& "-" & "$I$2:$I$" & lastRow _
& "-" & "$J$2:$J$" & lastRow _
& "-" & "$K$2:$K$" & lastRow) ' cột L = cột H - cột I - cột J - cột K
End Sub

Chú: Evaluate có thể gọi trực tiếp từ VBA nhưng thực ra nó là hàm bảng tính. Vì luật mặc định phần giao của bảng tính cho nên hàm SUM dùng ở đây rất rắc rối, tránh luôn cho tiện.

 

[ndphongskr]

Sub Con()
Dim lastRow As Long
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("L2:L" & lastRow) = Evaluate("=" & "$H$2:$H$" & lastRow _
& "-" & "$I$2:$I$" & lastRow _
& "-" & "$J$2:$J$" & lastRow _
& "-" & "$K$2:$K$" & lastRow) ' cột L = cột H - cột I - cột J - cột K
End Sub

Chú: Evaluate có thể gọi trực tiếp từ VBA nhưng thực ra nó là hàm bảng tính. Vì luật mặc định phần giao của bảng tính cho nên hàm SUM dùng ở đây rất rắc rối, tránh luôn cho tiện.

có code nào mà viết được như công thức kiểu như này mà chạy được khi đang lọc dữ liệu ko bác

.Formula = "=VLOOKUP(H2,Price!O,2,FALSE)"
bảng của mình nó nặng quá

 

[snow25]

có code nào mà viết được như công thức kiểu như này mà chạy được khi đang lọc dữ liệu ko bác

.Formula = "=VLOOKUP(H2,Price!O,2,FALSE)"
bảng của mình nó nặng quá

Thử cái này.

Liên kết: https://youtu.be/28LG16YW-Vg