[Giúp] VBA xóa dòng trong một cột có chứa giá trị "0"

[ngoctuyen1995]

Xin chào cả nhà GPEX!

Hiện tại em muốn xin code lọc ra các giá trị bằng "0" trong một cột "J "(cột số lượng) rồi xóa nguyên dòng của đó ạ...
Thường ngày em dùng Fiter ra các giá trị "0" ở cột Số Lượng rồi xóa thì nó chạy rất lâu, bởi vì data của em chứa dung lượng đến hơn 50 nghìn dòng nên rất mất thời gian ạ..

Mong các Thầy giúp đỡ ạ!

 

[phulien1902]

Xin chào cả nhà GPEX!

Hiện tại em muốn xin code lọc ra các giá trị bằng "0" trong một cột "J "(cột số lượng) rồi xóa nguyên dòng của đó ạ...
Thường ngày em dùng Fiter ra các giá trị "0" ở cột Số Lượng rồi xóa thì nó chạy rất lâu, bởi vì data của em chứa dung lượng đến hơn 50 nghìn dòng nên rất mất thời gian ạ..

Mong các Thầy giúp đỡ ạ!

Sub abc()
Application.ScreenUpdating = False
    Dim LR As Long, i As Long
        With Sheets("Data")
                LR = .Cells(Rows.Count, "A").End(xlUp).Row
                For i = LR To 2 Step -1
                    If .Cells(i, "J").Value = 0 Then
                        .Cells(i, "J").EntireRow.Delete
                    End If
                Next i
        End With
        Application.ScreenUpdating = True
End Sub

 

[Nguyễn Hồng Quang]

Cảm ơn anh đã làm code
Nhưng mà em chạy Code của trên bảng dữ liệu của em từ 200 dòng trở lên thì cũng hơi lâu ạ
Có cách nào nhanh hơn không anh

 

[hungpecc1]

Cảm ơn anh đã làm code
Nhưng mà em chạy Code của trên bảng dữ liệu của em từ 200 dòng trở lên thì cũng hơi lâu ạ
Có cách nào nhanh hơn không anh

hiển nhiên , với bảng tính lớn thì phương pháp chọn và xóa entity row có vẻ không hợp !

cho hỏi bảng tính có công thức ko hay chỉ có value !

 

[hungpecc1]

Cảm ơn anh đã làm code
Nhưng mà em chạy Code của trên bảng dữ liệu của em từ 200 dòng trở lên thì cũng hơi lâu ạ
Có cách nào nhanh hơn không anh

Cảm ơn anh đã làm code
Nhưng mà em chạy Code của trên bảng dữ liệu của em từ 200 dòng trở lên thì cũng hơi lâu ạ
Có cách nào nhanh hơn không anh

với file được định dạng (format) như bạn gửi lên, nếu dữ liệu có đến 20 000 dòng có thể tham khảo code này !

Sub A()
Dim tmpArr, Arr, i, j, n, dieukien_loc$, tmp, Lb&, Ub&
    tmpArr = Range("A2", [L65536].End(3))
    Lb = UBound(tmpArr, 1): Ub = UBound(tmpArr, 2)
    ReDim Arr(1 To Lb, 1 To Ub)
    dieukien_loc = Application.InputBox("Nhap gia tri cot so luong")
    For i = 1 To UBound(tmpArr, 1)
        tmp = tmpArr(i, 10)
        If Not tmp Like dieukien_loc Then
            '------------------
                n = n + 1
                For j = 1 To Ub
                    Arr(n, j) = tmpArr(i, j)
                Next
            '------------------
        End If
    Next
    If n Then
        Application.ScreenUpdating = False
        Range("A2", "L" & Lb).ClearContents
        Range("A2").Resize(n, Ub) = Arr
        Application.ScreenUpdating = True
    End If
    
End Sub

 

[phulien1902]

Cảm ơn anh đã làm code
Nhưng mà em chạy Code của trên bảng dữ liệu của em từ 200 dòng trở lên thì cũng hơi lâu ạ
Có cách nào nhanh hơn không anh

Bạn thử:

Sub Del_0()
    With Range("A:A")
        .AutoFilter Field:=10, Criteria1:="0"
        .SpecialCells(xlCellTypeConstants, 23).EntireRow.Delete
    End With
    ActiveSheet.AutoFilterMode = False
End Sub

 

[ngoctuyen1995]

Bạn thử:

Sub Del_0()
    With Range("A:A")
        .AutoFilter Field:=10, Criteria1:="0"
        .SpecialCells(xlCellTypeConstants, 23).EntireRow.Delete
    End With
    ActiveSheet.AutoFilterMode = False
End Sub

Chào Thầy!
Code sao xóa luôn hàng A1 (Template) luôn vậy ạ

 

[phulien1902]

Chào Thầy!
Code sao xóa luôn hàng A1 (Template) luôn vậy ạ

Bạn thay dòng:

With Range("A:A")

bằng

With Range("A2:L10000")

 

[hungpecc1]

Chào Thầy!
Code sao xóa luôn hàng A1 (Template) luôn vậy ạ

code mang tính chất định hướng giải thuật, để người dùng tham khảo, còn bạn có thể tùy biến theo ý muốn của mình , nếu ko muốn xóa hàng A1 thì bạn thử làm xem thế nào ? theo tôi đây cũng là một cách giúp các thành viên trau dồi và nâng cao hơn

 

[ngoctuyen1995]

Bạn thay dòng:

With Range("A:A")

bằng

With Range("A2:L10000")

Chào Thầy!
cho em hỏi doạn code này .SpecialCells(xlCellTypeConstants, 23).EntireRow.Delete - số 23 là gì vậy ạ, lúc em chạy với cục data lớn thì nó lại báo lỗi chỗ đó, em tìm hoài mà không hiểu ạ, mong thầy giúp đỡ

 

[ngoctuyen1995]

với file được định dạng (format) như bạn gửi lên, nếu dữ liệu có đến 20 000 dòng có thể tham khảo code này !

Sub A()
Dim tmpArr, Arr, i, j, n, dieukien_loc$, tmp, Lb&, Ub&
    tmpArr = Range("A2", [L65536].End(3))
    Lb = UBound(tmpArr, 1): Ub = UBound(tmpArr, 2)
    ReDim Arr(1 To Lb, 1 To Ub)
    dieukien_loc = Application.InputBox("Nhap gia tri cot so luong")
    For i = 1 To UBound(tmpArr, 1)
        tmp = tmpArr(i, 10)
        If Not tmp Like dieukien_loc Then
            '------------------
                n = n + 1
                For j = 1 To Ub
                    Arr(n, j) = tmpArr(i, j)
                Next
            '------------------
        End If
    Next
    If n Then
        Application.ScreenUpdating = False
        Range("A2", "L" & Lb).ClearContents
        Range("A2").Resize(n, Ub) = Arr
        Application.ScreenUpdating = True
    End If
   
End Sub

Chào Thầy!

Doạn code thì nhanh ạ, nhưng khi chạy code thì những dòng có giá trị 0 thì chỉ xóa data chứ không tự động dồn lên ạ

 

[phulien1902]

Chào Thầy!
cho em hỏi doạn code này .SpecialCells(xlCellTypeConstants, 23).EntireRow.Delete - số 23 là gì vậy ạ, lúc em chạy với cục data lớn thì nó lại báo lỗi chỗ đó, em tìm hoài mà không hiểu ạ, mong thầy giúp đỡ

Bạn gửi dữ liệu lớn tôi kiểm tra xem, vì không có không biết được.
Bạn tìm hiểu về phương thức SpecialCells nhé.
Điều bạn hỏi nghĩa là lấy các Cells không rỗng sau khi AutoFilter mà thôi

 

[phulien1902]

Chào Thầy!

Doạn code thì nhanh ạ, nhưng khi chạy code thì những dòng có giá trị 0 thì chỉ xóa data chứ không tự động dồn lên ạ

Bạn thay dòng:

Range("A2", "L" & Lb).ClearContents

bằng

Range("A2", "L" & Lb).Delete

 

[ngoctuyen1995]

Bạn thay dòng:

Range("A2", "L" & Lb).ClearContents

bằng

Range("A2", "L" & Lb).Delete

Cảm ơn Thầy đã giúp em hoàn thành dự án ạ... em cũng làm được rồi..
Chúc Thầy sức khỏe và Thành công..!

 

[hongphuong1997]

Dim tmpArr, Arr, i, j, n, dieukien_loc$, tmp, Lb&, Ub&
tmpArr = Range("A2", [L65536].End(3))
Lb = UBound(tmpArr, 1): Ub = UBound(tmpArr, 2)
ReDim Arr(1 To Lb, 1 To Ub)
dieukien_loc = ("0","15","20")
For i = 1 To UBound(tmpArr, 1)
tmp = tmpArr(i, 10)
If Not tmp Like dieukien_loc Then
'------------------
n = n + 1
For j = 1 To Ub
Arr(n, j) = tmpArr(i, j)
Next
'------------------
End If
Next
If n Then
Application.ScreenUpdating = False
Range("A2", "L" & Lb).ClearContents
Range("A2").Resize(n, Ub) = Arr
Application.ScreenUpdating = True
End If

End Sub

Anh @hungpecc1 oi cho em hỏi như này nhé
Nếu muốn xóa nhiều điều kiện 1 lúc thì sửa code như nào hở anh?
Em cảm ơn ạ.

 

[hungtin1997]

Ctrl+H để đưa ô 0 về rỗng, dung Goto Special để chọn ô rỗng rồi xóa cả dòng. Không cần code