Xóa dòng có điều kiện (1 người xem)

[lhthai]

Hiện tại đang dùng code sau
code 1 lấy điều kiện cần xóa dòng

Private Sub CommandButton1_Click()
Dim Arr(), I As Long, Rng As Range
   With Sheet2
      Arr = .Range("A3", .[A65536].End(3)).Resize(, 2).Formula
   End With
   For I = 1 To UBound(Arr)
      Set Rng = Sheet1.[A:A].Find(Arr(I, 1), , , xlWhole)
      If Not Rng Is Nothing Then
            Arr(I, 2) = Rng.Offset(, 2)
      End If
   Next
   Sheet2.[A3].Resize(I - 1, 2) = Arr
End Sub

code 2 xóa dòng theo điều kiện

Private Sub CommandButton2_Click()
Dim Rng1 As Range, Clls As Range
Set Rng1 = Sheet2.Range("B5:B65536")
For Each Clls In Rng1
    If Clls.Value <> Empty Then
        Clls.Resize(, 100).ClearContents
    End If
    Next
End Sub

Hiện tại code xóa dòng chạy chậm khi dữ liệu nhiều
nay muốn nhờ các anh viết code khác nhanh hơn.

 

[giola]

Xóa vất vả vậy, thay code2 thành

Private Sub CommandButton2_Click()
   with Sheet2
       .Range(.Range("B5"),.Range("B65536").end(xlup)).ClearContents
   end with
End Sub

Nếu cần cải thiện nữa, code1 thì nên post file lên thì mới hiểu được code1 đó thực hiện gì.

 

[giola]

xem lại File của bạn thì thấy code2 nên sửa như sau cho chuẩn hơn

Private Sub CommandButton2_Click()
    Range(Range("B5"), Range("A65536").End(xlUp).Offset(, 1)).Resize(, 100).ClearContents
End Sub

 

[lhthai]

xem lại File của bạn thì thấy code2 nên sửa như sau cho chuẩn hơn

Private Sub CommandButton2_Click()
    Range(Range("B5"), Range("A65536").End(xlUp).Offset(, 1)).Resize(, 100).ClearContents
End Sub

Mình muốn xóa dòng theo điều kiện còn các dòng khác vẫn giữ giá trị.
Cám ơn bạn đã giành thời gian hộ trợ.

 

[giola]

Mình muốn xóa dòng theo điều kiện còn các dòng khác vẫn giữ giá trị.
Cám ơn bạn đã giành thời gian hộ trợ.

Không hiểu; xoá dòng hay xoá nội dung của ô đó

ClearContents là xoá nội dung vùng (các ô) mà thôi

Và điều kiện cột B khác rỗng thì xoá ah?

 

[lhthai]

Không hiểu; xoá dòng hay xoá nội dung của ô đó

ClearContents là xoá nội dung vùng (các ô) mà thôi

Và điều kiện cột B khác rỗng thì xoá ah?

Đúng rồi bạn các điều kiện cột B khác rỗng thì ClearContents

 

[giola]

Đúng rồi bạn các điều kiện cột B khác rỗng thì ClearContents

Vậy thì thế này đi cho nhanh

Private Sub CommandButton2_Click()
    Dim i As Long, aR, Rng As Range
    Set Rng = Range("B65536").End(xlUp)
    If Rng.Row < 5 Then Exit Sub
    
    aR = Range(Range("B5"), Rng).Value
    Set Rng = Range("B65536")
    For i = 1 To UBound(aR)
        If aR(i, 1) <> "" Then Set Rng = Union(Rng, Range("B5").Offset(i - 1).Resize(, 100))
    Next i
    Rng.ClearContents
End Sub

 

[lhthai]

Vậy thì thế này đi cho nhanh

Private Sub CommandButton2_Click()
    Dim i As Long, aR, Rng As Range
    Set Rng = Range("B65536").End(xlUp)
    If Rng.Row < 5 Then Exit Sub
    
    aR = Range(Range("B5"), Rng).Value
    Set Rng = Range("B65536")
    For i = 1 To UBound(aR)
        If aR(i, 1) <> "" Then Set Rng = Union(Rng, Range("B5").Offset(i - 1).Resize(, 100))
    Next i
    Rng.ClearContents
End Sub

Cám ơn bạn code này nhanh hơn nhiều

 

[Quang_Hải]

Hiện tại đang dùng code sau
code 1 lấy điều kiện cần xóa dòng

Private Sub CommandButton1_Click()
Dim Arr(), I As Long, Rng As Range
   With Sheet2
      Arr = .Range("A3", .[A65536].End(3)).Resize(, 2).Formula
   End With
   For I = 1 To UBound(Arr)
      Set Rng = Sheet1.[A:A].Find(Arr(I, 1), , , xlWhole)
      If Not Rng Is Nothing Then
            Arr(I, 2) = Rng.Offset(, 2)
      End If
   Next
   Sheet2.[A3].Resize(I - 1, 2) = Arr
End Sub

code 2 xóa dòng theo điều kiện

Private Sub CommandButton2_Click()
Dim Rng1 As Range, Clls As Range
Set Rng1 = Sheet2.Range("B5:B65536")
For Each Clls In Rng1
    If Clls.Value <> Empty Then
        Clls.Resize(, 100).ClearContents
    End If
    Next
End Sub

Hiện tại code xóa dòng chạy chậm khi dữ liệu nhiều
nay muốn nhờ các anh viết code khác nhanh hơn.

Thay 2 đoạn code kia bằng code này xem sao

Sub DelData()
Dim dk(), D As Object, Col As Byte
Dim i As Long, Data(), j As Long
Col = 14
Set D = CreateObject("scripting.dictionary")
dk = Sheet1.Range("A3", Sheet1.[A65536].End(3)).Value
With Sheet2
   Data = .Range("A5", .[A65536].End(3)).Resize(, Col).Value
   For i = 1 To UBound(dk)
      D(dk(i, 1)) = ""
   Next
   For i = 1 To UBound(Data)
      If D.exists(Data(i, 1)) Then
         For j = 2 To Col
            Data(i, j) = ""
         Next
      End If
   Next
   .[A5].Resize(i - 1, UBound(Data, 2)) = Data
End With
End Sub