如何删除所有不包含特定值的单元格（在VBA / Excel中）

Question

I fully didn't understand how to follow the answer in vba deleting rows that do not contain set values defined in range (I need to use VBA for this). From what I gathered, i need to specify an array, then use some if then stuff.

In my case, I want to create something that will search just a specified column and delete all values that do not contain specific letters/numbers. 1,2,3,4,5,s,f,p,a,b,c,o are the numbers/letters i want to keep. Cells which do not contain these values (even 11 or 1s should be deleted), I want only to delete the cell (not the whole row) and shift the cells below it up (i believe you can do this with the default .delete command).

For example my columns look like this:

p
a
1
2
5
s
f
s
8

31
4
f

I want to screen my data so that all blank cells and all cells which do not contain the numbers or letter mentioned above (eg 31 and 8 in this case) are automatically deleted.

Thanks for your help!

Answer 1

Sub Tester()

Dim sKeep As String, x As Long
Dim rngSearch As Range, c As Range

    'C1:C5 has values to keep
    sKeep = Chr(0) & Join(Application.Transpose(Range("C1:C5").Value), _
                                Chr(0)) & Chr(0)

    Set rngSearch = Range("A1:A100")

    For x = rngSearch.Cells.Count To 1 Step -1
        Set c = rngSearch.Cells(x)
        If InStr(sKeep, Chr(0) & c.Value & Chr(0)) = 0 Then
            c.Delete shift:=xlShiftUp
        End If
    Next x

End Sub

Answer 2

This will do

Sub Main()

Dim dontDelete
dontDelete = Array("1", "2", "3", "4", "5", "s", "f", "p", "a", "b", "c", "o")

Dim i As Long, j As Long

Dim isThere As Boolean

For i = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
    For j = LBound(dontDelete) To UBound(dontDelete)
        If StrComp(Range("A" & i), dontDelete(j), vbTextCompare) = 0 Then
            isThere = True
        End If
    Next j
    If Not isThere Then
        Range("A" & i).Delete shift:=xlUp
    End If
    isThere = False
Next i

End Sub

Answer 3

Sub DeleteValues()
Dim x As Integer
Dim i As Integer
Dim Arr(1 To 3) As String

Arr(1) = "1"
Arr(2) = "2"
Arr(3) = "3"

Range("A1").Select

For x = 1 To 10
    For i = 1 To 3
        If ActiveCell.Value = Arr(i) Then
            ActiveCell.Delete
        End If
    Next i
    ActiveCell.Offset(1, 0).Select
Next x

End Sub

This will loop through range("a1:a10") and delete any cell where the value = any of the array values (1,2,3)

You should hopefully be able to work with this code and suit it to your needs?

Answer 4

Another way :) Which doesn't delete the cells in a loop.

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim rngDEL As Range
    Dim strDel As String
    Dim arrDel
    Dim i As Long

    strDel = "1,11,Blah" '<~~ etc... You can pick this from a range as well
    arrDel = Split(strDel, ",")

    Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws.Columns(1) '<~~ Change this to the relevant column
        For i = LBound(arrDel) To UBound(arrDel)
            .Replace What:=arrDel(i), Replacement:="", LookAt:=xlWhole, SearchOrder:= _
            xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
        Next i

        On Error Resume Next
        Set rngDEL = .Cells.SpecialCells(xlCellTypeBlanks)
        On Error GoTo 0

        If Not rngDEL Is Nothing Then rngDEL.Delete Shift:=xlShiftUp
    End With
End Sub