Code xóa dòng trắng dựa vào điều kiện.

[thinhnx22]

Chào anh chị em GPE,
Trong file đính kèm, những dòng nào có số lượng = 0 thì toàn bộ những dòng đó được xóa. Các bạn giúp mình. Cảm ơn các bạn

 

[Hieu042]

thực ra cái này mình nghĩ đơn giản là không cần code kiết gì cũng OK.
Bạn chỉ cần filter cái Blank với cái bằng 0 rồi chọn xóa là xong mà.

 

[thinhnx22]

thực ra cái này mình nghĩ đơn giản là không cần code kiết gì cũng OK.
Bạn chỉ cần filter cái Blank với cái bằng 0 rồi chọn xóa là xong mà.

Mình cũng thử rồi nhưng máy quay dữ quá bạn ạ. Cảm ơn bạn nhé

 

[Hieu042]

vì mình cũng sử lý dữ liệu vài chục k dòng là bình thường mà.
Có lẽ vấn đề của bạn không nằm ở chỗ file có nhiều dữ liệu khác gây nặng file thôi.
Nếu như vậy thì code chạy cũng nặng đó.

Bạn thử kiểm tra lại xem, có thể file bị nặng do nhiều công thức, định dạng không cần thiết hay có object thừa...v...v

 

[thinhnx22]

vì mình cũng sử lý dữ liệu vài chục k dòng là bình thường mà.
Có lẽ vấn đề của bạn không nằm ở chỗ file có nhiều dữ liệu khác gây nặng file thôi.
Nếu như vậy thì code chạy cũng nặng đó.

Bạn thử kiểm tra lại xem, có thể file bị nặng do nhiều công thức, định dạng không cần thiết hay có object thừa...v...v

Mình đang xem lại file. Mình cũng đã nghĩ đến trường hợp như bạn nói. Object mình kiểm tra không thấy có.

 

[snow25]

Chào anh chị em GPE,
Trong file đính kèm, những dòng nào có số lượng = 0 thì toàn bộ những dòng đó được xóa. Các bạn giúp mình. Cảm ơn các bạn

Chỉnh code của bạn 1 chút bạn ứng dụng nhé.

Sub xoadong()
Dim Rng As Range, Sarr, I As Long, K As Long, kq, j As Long
Set Rng = Range("A1:E5")
Sarr = Rng.Formula
ReDim kq(1 To UBound(Sarr), 1 To UBound(Sarr, 2))
For I = 1 To UBound(Sarr)
    If Sarr(I, 3) <> Empty Then
        K = K + 1
        For j = 1 To UBound(Sarr, 2)
            kq(K, j) = Sarr(I, j)
        Next j
    End If
Next I
   If K Then Range("A13:E13").Resize(K).Formula = kq
End Sub

 

[thinhnx22]

Chỉnh code của bạn 1 chút bạn ứng dụng nhé.

Sub xoadong()
Dim Rng As Range, Sarr, I As Long, K As Long, kq, j As Long
Set Rng = Range("A1:E5")
Sarr = Rng.Formula
ReDim kq(1 To UBound(Sarr), 1 To UBound(Sarr, 2))
For I = 1 To UBound(Sarr)
    If Sarr(I, 3) <> Empty Then
        K = K + 1
        For j = 1 To UBound(Sarr, 2)
            kq(K, j) = Sarr(I, j)
        Next j
    End If
Next I
   If K Then Range("A13:E13").Resize(K).Formula = kq
End Sub

Thay đi duyệt xóa từng dòng số lượng = 0 từ dưới lên thì mình lấy luôn kết quả khác rỗng rồi áp vào mảng. Kết quả đã đúng ý mình, Cảm ơn bạn nhiều nhé.