Как удалить данные из ячеек, длина которых равна или превышает 9 символов?

Question

Мне нужно удалить данные из ячеек, состоящие из 9 или более цифр или символов.Например, это следует удалить: 123456789, 987654321, 1234567898765 и т. Д.

Я уже получил код, который проверяет каждую отдельную часть ячейки для сравнения, но у меня возникла проблема при создании спецификации числа.

Пример строки кода для работы будет выглядеть так:

Aegis Transformation Cycle 566609354 Agent 73849496753

Мой код:

For g = 2 to RowNumber
    MyCell = " " & Cells(g, 2).Value & " "
    Word = Split(MyCell, " ")
    For j = 0 To UBound(Word)
        If Word >= 100000000 Then
            Cells(g, 2).Replace What:=Word(j), Replacement:=""
        End If 
    Next j
Next g

Answer 1

Вы можете легко достичь этого с помощью регулярных выражений.Следующий код идентифицирует любую часть вашей строки, которая содержит число, равное или длиннее 9 символов, и удаляет их

Public Sub Demo()
    Dim RegExp As Object
    Dim rng As Range
    Dim matches
    Dim c

    Set rng = Sheet1.Range("A1")

    Set RegExp = CreateObject("vbscript.regexp")

    With RegExp
        .MultiLine = False
        .Global = True
        .IgnoreCase = False
        .Pattern = "[0-9]{9,}"

        For Each c In rng
            If .test(c) Then
                Set matches = .Execute(c)
                MsgBox .Replace(c, vbNullString)
            End If
        Next c
    End With

End Sub

Answer 2

Вы также можете использовать функцию Len() с Trim() следующим образом:

Sub DeleteBlanks()

Dim g As Long, RowNumber As Long

    With Sheets("SheetName")
        'Finds the last row in the first column
        RowNumber = .Cells(Rows.Count, 1).End(xlUp).Row

        For g = 1 To RowNumber 
            'Note:Value2 reads cells W/O formatting and is faster
            If Len(Trim(.Cells(g, 1).Value2)) >= 9 Then
                .Cells(g, 1).ClearContents
            End If
        Next g

    End With

End Sub

Answer 3

Одним из способов является использование регулярных выражений .

Sub x()

Dim r As Range

With CreateObject("VBScript.RegExp")
    .Global = True
    .Pattern = "\d{9,}"
    For Each r In Range("A1:A10")
        r.Offset(, 1) = .Replace(r, "")
    Next r
End With

End Sub