[Sửa giúp] Dùng VBA Xóa bỏ các giá trị không được lọc bằng AutoFilter (1 người xem)

  • Thread starter Thread starter quyenpv
  • Ngày gửi Ngày gửi
Liên hệ QC

Người dùng đang xem chủ đề này

quyenpv

Thu nhặt kiến thức
Tham gia
5/1/13
Bài viết
726
Được thích
97
Giới tính
Nam
Nghề nghiệp
Decode cuộc đời!
Tôi có 1 hàm dùng để xóa bỏ giá trị AutoFilter sau khi được lọc trên Sheet. Bây giờ muốn ngược lại là xóa bỏ giá trị không được lọc, nhờ anh chị em trên diễn đàn sửa giúp. Cám ơn rất nhiều
Mã:
Sub DeleteFilter_Value()
'Declare the variables
Dim rngFilt As Range
Dim CellCount As Long
Dim Msg As String


'If the data has not been filtered with the AutoFilter, exit the sub
With ActiveSheet
    If .AutoFilterMode = False Or .FilterMode = False Then
        MsgBox "Please filter the data with the AutoFilter, and try again!"
        Exit Sub
    End If
End With


With ActiveSheet.AutoFilter.Range


'For Excel 2007 and earlier, check for the SpecialCells limitation
If Val(Application.Version) < 14 Then


On Error Resume Next
CellCount = .Columns(1).SpecialCells(xlCellTypeVisible) _
.Areas(1).Cells.Count
On Error GoTo 0


If CellCount = 0 Then
    Msg = "The SpecialCells limit of 8,192 areas has been "
    Msg = Msg & vbNewLine
    Msg = Msg & "exceeded for the filtered value."
    Msg = Msg & vbNewLine & vbNewLine
    Msg = Msg & "Tip: Sort the data, and try again!"
    MsgBox Msg, vbExclamation, "SpecialCells Limitation"
    GoTo ExitTheSub
End If


End If


'Set the filtered range
On Error Resume Next
Set rngFilt = .Resize(.Rows.Count - 1, 1).Offset(1, 0) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0


'Delete the filtered data
If Not rngFilt Is Nothing Then
    rngFilt.EntireRow.Delete
Else
    MsgBox "No records are available to delete...", vbExclamation
End If


End With


ExitTheSub:


'Clear the filter
ActiveSheet.ShowAllData
End Sub
 
Bạn thử bỏ chữ Not dòng dưới đây xem thế nào nhé
If Not rngFilt Is Nothing Then
 
Upvote 0
Đoạn code này của mình có hơi nông dân nhưng cứ đưa lên: %#^#$
Sub test()

Dim af As AutoFilter
Dim rng As Range


Application.DisplayAlerts = False


Set af = ActiveSheet.AutoFilter
Set rng = af.Range
For i = rng.Rows.Count To 1 Step -1

If rng(i, 1).Rows.Hidden Then
rng(i, 1).Rows.Delete
End If

Next


Application.DisplayAlerts = True
End Sub
 
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom