Cần giúp đỡ tự động xóa ô có chứa số 0,0

[hung2412]

Nếu bạn định dạng lại, thực tế số 0.0 là những con số rất nhỏ
Nếu muốn chính xác hơn nữa thì chỉ cần trong khoảng 0.00001 và -0.00001

Vâng, đúng như anh nói, số 0,0 đó rất nhỏ. Chỉ cần thu hẹp khoảng cách như vầy sẽ ổn.

 

[hoanglocphat]

Tôi xem file thì thực tế số 0.0 đấy không phải là số 0, vậy thầy Batê mới để code <0.1
Nếu không muốn xóa những số <0, thì thêm điều kiện and vào

Public Sub GPE()Dim Rng As Range, Cll As Range
Set Rng = Range([B8], [B65536].End(xlUp)).Offset(, 3).Resize(, 4)
For Each Cll In Rng
    If Cll.Value < 0.1 And Cll.Value > -0.1 Then Cll.Value = Empty
Next Cll
Set Rng = Nothing
End Sub

Chào các bạn!
Các bạn có thể giúp cải tiến code trên . Vì File có vài chục ngàn dòng thì code trên chạy rất lâu
Xin cảm ơn!

 

[Cá ngừ F1]

Chào các bạn!
Các bạn có thể giúp cải tiến code trên . Vì File có vài chục ngàn dòng thì code trên chạy rất lâu
Xin cảm ơn!

Đưa file và nêu yêu cầu xem sao bạn?

 

[nvson]

Nếu dùng thủ công: Tại sao bạn không dùng chức năng filter có sẵn của Excel? Còn nếu dùng VBA thì cũng nên sử dụng chức năng Filter để xóa dữ liệu. Đảm bảo chạy nhanh không ngờ!!!!!

 

[huy vu]

Nếu dùng thủ công: Tại sao bạn không dùng chức năng filter có sẵn của Excel? Còn nếu dùng VBA thì cũng nên sử dụng chức năng Filter để xóa dữ liệu. Đảm bảo chạy nhanh không ngờ!!!!!

Anh nvson có thể chia sẻ thêm cách làm filter rồi xóa bằng vba đc không ạ?
Em cảm ơn

 

[nvson]

Bạn tham khảo cóe sau:

Option Explicit
Sub thu_xoa()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Dim i, n, m
    n = Range("A65536").End(xlUp).Row
    
    Rows("7:7").Select
    Selection.AutoFilter
    
        
    For i = 1 To 4
        ActiveSheet.Range("$A$7:$H$" & n).AutoFilter Field:=i + 4, Criteria1:="<=0.01"
        m = Range("A65536").End(xlUp).Row
        If m > 7 Then
            Range("A8:A" & n).Offset(0, i + 3).Select
            Selection.ClearContents
            ActiveSheet.ShowAllData
        End If
        
    Next i
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
End Sub

 

[KhanhChi29]

Bạn tham khảo cóe sau:

Option Explicit
Sub thu_xoa()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Dim i, n, m
    n = Range("A65536").End(xlUp).Row
    
    Rows("7:7").Select
    Selection.AutoFilter
    
        
    For i = 1 To 4
        ActiveSheet.Range("$A$7:$H$" & n).AutoFilter Field:=i + 4, Criteria1:="<=0.01"
        m = Range("A65536").End(xlUp).Row
        If m > 7 Then
            Range("A8:A" & n).Offset(0, i + 3).Select
            Selection.ClearContents
            ActiveSheet.ShowAllData
        End If
        
    Next i
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
End Sub

Đúng là cách này sẽ nhanh hơn
Nếu không muốn xóa thì dùng định dạng có điều kiện cho thành màu trắng với điều kiện như code của Cangu
< 0.1 And > -0.1

 

[hoanglocphat]

Đưa file và nêu yêu cầu xem sao bạn?

Đây là file thực tế (File này tôi lấy trên diễn đàn, thực tế file của tôi khá nặng khỏang 10Mb và do chạy code nên hay tạo ra các số Epsilon)
Tôi đã áp dụng code trên , nhưng nó chạy đến hơn 32 s! Nếu kết hợp chạy đồng thời các code khác thì rất lâu.
Các bạn giúp tôi code nào để có thể chạy nhanh hơn, tôi thấy các bạn hay dùng Dic hay mảng gì đó! kg biết có thể áp dụng được không?
Tôi muốn xóa các số Epsilon (hay các số nhỏ hơn 0,001 cũng được) từ cột D đến cột J, từ dòng thứ 11 trở xuống (các ô có tô màu đỏ là cần xóa)
Nhờ các bạn viết giúp code giùm, xin cảm ơn!

 

[Ba Tê]

Đây là file thực tế (File này tôi lấy trên diễn đàn, thực tế file của tôi khá nặng khỏang 10Mb và do chạy code nên hay tạo ra các số Epsilon)
Tôi đã áp dụng code trên , nhưng nó chạy đến hơn 32 s! Nếu kết hợp chạy đồng thời các code khác thì rất lâu.
Các bạn giúp tôi code nào để có thể chạy nhanh hơn, tôi thấy các bạn hay dùng Dic hay mảng gì đó! kg biết có thể áp dụng được không?
Tôi muốn xóa các số Epsilon (hay các số nhỏ hơn 0,001 cũng được) từ cột D đến cột J, từ dòng thứ 11 trở xuống (các ô có tô màu đỏ là cần xóa)
Nhờ các bạn viết giúp code giùm, xin cảm ơn!

Từ code giải quyết từng Cell của bạn:

Public Sub Xoaepxilong_No()
Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
Dim Rng As Range, Cll As Range
Dim StartTime As Double
    StartTime = Timer
Set Rng = Range([B11], [B65536].End(xlUp)).Offset(, 2).Resize(, 7)
For Each Cll In Rng
    If Cll.Value < 0.1 And Cll.Value > -0.1 Then Cll.Value = Empty
Next Cll
Set Rng = Nothing

Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox Format(Timer - StartTime, "00.000") & " giây."
End Sub

Thử chuyển xài code giải quyết trong mảng rồi gán xuống sheet xem sao

Public Sub Xoaxoa()
Dim Arr(), I As Long, J As Long, R As Long, t As Variant
t = Timer
R = [D65536].End(xlUp).Row
Arr = Range("D11:J" & R).Value2
For I = 1 To UBound(Arr, 1)
    For J = 1 To 7
        If Arr(I, J) < 0.01 Then Arr(I, J) = Empty
    Next J
Next I
Range("D11:J" & R) = Arr
MsgBox Timer - t
End Sub

 

[hoanglocphat]

Em cảm ơn Thầy ba Tê nhiều!