특정 수의 값을 기반으로 셀을 삭제하려면 어떻게합니까?

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 

이것의 장점은 당신이 한 번에 여러 행과 열을 청소하고, 다시 그것을 밖으로 뱉어 수 있다는 것입니다.