Question

我一直试图找到一种方法来过滤和/或排序Excel中的某些数据而没有任何运气。

在B栏中，我有数千个数据单元格。

单元格中的一些数据示例

BP18529
AUG987
AG723KK
DERT429
732KSM

这些只是一些例子，还有更多，也有不同的字母和数字混合。

我想要做的是过滤/删除包含此格式的所有单元格BP18529;因为不是那个特定的数据，而是所有以两个字母开头并以五个数字结尾的单元格。

我无法安装任何插件。认为我应该能够用VBA脚本做到这一点？

Answer 1

你可以用这个

Sub main()
    Dim i As Long

    For i = Cells(Rows.Count, 2).End(xlUp).Row To 1 Step -1 ' loop through columns B cells from last not empty one backwards
        If IsToDelete(Cells(i, 2).Text) Then Cells(i, 2).EntireRow.Delete ' if current cell satisfy deletion criteria then delete its entire row
    Next
End Sub

Function IsToDelete(Txt As String) As Boolean
    Select Case Asc(UCase(Mid(Txt, 1, 1))) ' check if first character is a letter
        Case 65 To 90
        Select Case Asc(UCase(Mid(Txt, 2, 1))) ' check if second character is a letter
            Case 65 To 90
            Select Case Asc(Mid(Txt, 3, 1)) ' check if third character is a number
                Case 48 To 59
                    IsToDelete = IsNumeric(Right(Txt, 5)) ' mark for deletion if last 5 characters are a number
            End Select
        End Select
    End Select
End Function

Answer 2

首先，您需要遍历所有数据以检查每个单元格。因为你想要删除你需要向后循环的行，否则你会改变行号并且循环不会正确计算。

使用IsNumeric()，您可以轻松检查左侧2个字符是否为数字，右侧5个字符是否为数字。

Option Explicit

Public Sub DeleteSpecificDataItems()
    Dim ws As Worksheet
    Set ws = Worksheets("Tabelle5") 'define which worksheet

    Dim lRow As Long
    lRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row 'find last used row in column B

    Dim iRow As Long
    For iRow = lRow To 1 Step -1 'loop backwards
        Dim iCell As Range
        Set iCell = ws.Cells(iRow, "B")

        If Len(iCell.Value) = 7 Then 'check if length = 7
            'chech if left 2 characters are not numeric AND right 5 characters are numeric
            If Not IsNumeric(Left$(iCell.Value, 1)) And Not IsNumeric(Mid$(iCell.Value, 2, 1)) And IsNumeric(Right$(iCell.Value, 5)) Then
                iCell.EntireRow.Delete 'delete row
            End If
        End If
    Next iRow

End Sub

您可能希望使用Application.ScreenUpdating = False/True来加快速度。

Answer 3

尝试

Option Explicit

Public Sub test()

    Dim rng As Range
    Dim unionRng As Range

    Set rng = ThisWorkbook.Worksheets("Sheet8").Range("B1") 'change to range required

    Dim currCell As Range

    For Each currCell In rng

        If PatternFound(currCell.Text) Then

            If Not unionRng Is Nothing Then
                Set unionRng = Union(unionRng, currCell)
            Else
                Set unionRng = currCell
            End If

        End If

    Next currCell

    If Not unionRng Is Nothing Then unionRng.ClearContents ' or unionRng.EntireRow.Delete

End Sub

Public Function PatternFound(ByVal Txt As String) As Boolean

    Application.Volatile
    Dim regex As Object
    Dim matches As Object
    Set regex = CreateObject("VBSCRIPT.REGEXP")

    With regex

      .Pattern = "[A-Za-z]{2}[0-9]{5}"
      .Global = True
      .MultiLine = True
      .IgnoreCase = True
       Set matches = .Execute(Txt)
   End With

   If matches.Count > 0 Then PatternFound = True

End Function

Excel-VBA：过滤/排序“复杂”数据

3 个答案: