Question

我有大量数据，其中一些单元格包含数字，句号和下划线的混合。但是，我想制作一个宏，它将删除包含数字等的单元格，以便剩下的唯一单元格包含字母表中的字母。下面是我目前的代码，但它无法正常工作。我该如何解决？

    Sub Sample()
Dim ws As Worksheet
Dim strSearch As String
Dim Lrow As Long


strSearch = "."
strSearch = "0"
strSearch = "1"
strSearch = "2"
strSearch = "3"
strSearch = "4"
strSearch = "5"
strSearch = "6"
strSearch = "7"
strSearch = "8"
strSearch = "9"
strSearch = "."


Set ws = Sheets("Sheet1")

With ws
    Lrow = .Range("A" & .Rows.Count).End(xlUp).Row

    '~~> Remove any filters
    .AutoFilterMode = False

    '~~> Filter, offset(to exclude headers) and delete visible rows
    With .Range("A1:A" & Lrow)
      .AutoFilter Field:=1, Criteria1:="=*" & strSearch & "*"
      .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With

    '~~> Remove any filters
    .AutoFilterMode = False
End With
End Sub

我也有一些代码无法正常工作。我应该使用哪一个以及如何修复它们？另外，我应该使用哪一个？

    Sub Test()
Dim cell As Range

For Each cell In Selection
If InStr(1, cell, "1", vbTextCompare) > 0 Then
    cell.EntireRow.Delete
    End If
Next
For Each cell In Selection
If InStr(1, cell, "2", vbTextCompare) > 0 Then
    cell.EntireRow.Delete
    End If
Next
For Each cell In Selection
If InStr(1, cell, "3", vbTextCompare) > 0 Then
    cell.EntireRow.Delete
End If
Next
For Each cell In Selection
If InStr(1, cell, "4", vbTextCompare) > 0 Then
    cell.EntireRow.Delete
End If
Next
For Each cell In Selection
If InStr(1, cell, "5", vbTextCompare) > 0 Then
    cell.EntireRow.Delete
End If
Next
For Each cell In Selection
If InStr(1, cell, "6", vbTextCompare) > 0 Then
    cell.EntireRow.Delete
End If
Next
For Each cell In Selection
If InStr(1, cell, "7", vbTextCompare) > 0 Then
    cell.EntireRow.Delete
End If
Next
For Each cell In Selection
If InStr(1, cell, "8", vbTextCompare) > 0 Then
    cell.EntireRow.Delete
End If
Next
For Each cell In Selection
If InStr(1, cell, "9", vbTextCompare) > 0 Then
    cell.EntireRow.Delete
End If
Next
For Each cell In Selection
If InStr(1, cell, "0", vbTextCompare) > 0 Then
    cell.EntireRow.Delete
End If
Next
For Each cell In Selection
If InStr(1, cell, ".", vbTextCompare) > 0 Then
    cell.EntireRow.Delete
End If
Next
End Sub

Answer 1

你可以试试这个：

Sub Sample()
    Dim strSearch As Variant

    strSearch = Array("*.*", "*0*", "*1*", "*2*", "*3*", "*4*", "*5*", "*6*", "*7*", "*8*", "*9*", "*_*")
    With Sheets("Sheet01")
        With .Range("A1", .Cells(.Rows.count, 1).End(xlUp))
            .AutoFilter Field:=1, Criteria1:=strSearch, Operator:=xlFilterValues
            If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then .Offset(1).Resize(.Rows.count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        End With
        .AutoFilterMode = False
    End With
End Sub

Answer 2

这取决于你希望用这个宏完成什么。以下宏将满足您的需求：

Sub CleanNumerics()
Application.ScreenUpdating = False

Dim ws As Worksheet
Dim r As Range
Dim cell As Range

Dim i As Long
Dim j As Long

Dim args() As Variant

' Load your arguments into an array to allow looping
args() = Array(".", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "_")

' Load your selection into a range variable
Set r = Selection

' By stepping backwards we wont skip cells as we delete rows.
For i = r.Cells.Count To 1 Step -1
    ' Loop through the number of arguments in our array.
    For j = 0 To UBound(args())
        ' If one of the noted characters is in the cell, the row
        ' is deleted and the loop exits.
        If InStr(1, r.Cells(i), args(j)) > 0 Then
            r.Cells(i).EntireRow.Delete
            Exit For
        End If
    Next
Next


End Sub

此方法存在的问题是您要删除整行，这可能会导致问题，具体取决于您的应用程序。此外，如果您使用大型数据集执行此操作，则可能需要很长时间。您可以使用数组来克服这个问题，但这些可能会变得复杂。

使用数组执行此操作将如下所示：

Sub ArrayWithoutNumbers()
Application.ScreenUpdating = False

Dim ws As Worksheet
Dim r As Range
Dim cell As Range

Dim i As Long
Dim j As Long
Dim k As Long
Dim m As Long

Dim args() As Variant

Dim array_1() As Variant
Dim array_2() As Variant

Dim flag As Boolean

' Load your arguments into an array to allow looping
args() = Array(".", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "_")

' Load your selection into a range variable
On Error GoTo Err
array_1() = Selection.Value
On Error GoTo 0

' First determine if a two dimensional array has created. If so, loop through rows
' and columns. If not, go to the other loop.
If UBound(array_1, 2) > 1 Then
    For i = 1 To UBound(array_1, 1)
        For j = 1 To UBound(array_1, 2)
            flag = False
            For k = 0 To UBound(args())
                If InStr(1, array_1(i, j), args(k)) > 0 Then
                    flag = True ' Sets a flag so that the item is not added.
                    Exit For    ' Exit the loop
                End If
            Next

            ' If the flag hasn't been raised, resize the array and add the item.
            If flag = False Then
                m = m + 1
                ReDim Preserve array_2(1 To m)
                array_2(m) = array_1(i, j)
            End If
        Next
    Next

' Loops through only the rows of the array.

ElseIf UBound(array_1, 2) = 1 Then
    For i = 1 To UBound(array_1, 1)
        For k = 0 To UBound(args())
            If InStr(1, array_1(i), args(k)) > 0 Then
                flag = True
                Exit For
            End If
        Next
        If flag = False Then
            m = m + 1
            ReDim Preserve array_2(1 To m)
            array_2(m) = array_1(i)
        End If
    Next
End If

' Adds a worksheet to output to. You can adjust this as needed.

ActiveWorkbook.Sheets.Add
ActiveSheet.Range("A1").Resize(UBound(array_2, 1), 1).Value = array_2()

Exit Sub

Err:

End Sub

这样做的好处是，您可以一次清理多个行和列，并将其吐出来。

如何根据一定数量的值删除单元格？

2 个答案: