Как удалить все, что начинается с цифр в конце текстовой строки в VBA?

Question

Так что в настоящее время мой код VBA выглядит следующим образом:

Sub Testing()

Dim K As Long
Dim LR As Long
LR = Cells(Rows.Count, 1).End(xlUp).Row


For K = 2 To LR
   Cells(K, 2).Value = StripAfter(Cells(K, 1), "_", 6)
Next K

End Sub


Function StripAfter(ByVal txt As String, ByVal delimiter As String, ByVal 
  occurrence As Long) As String
    Dim x As Variant
    x = Split(expression:=txt, delimiter:=delimiter, limit:=occurrence + 1)

    StripAfter = x(UBound(x))
End Function

У меня это связано с кнопкой, которая будет выводить данные следующим образом: (Примечание: вставлен столбец A, столбец B являетсярезультат после запуска макроса VBA)

С этим выводом получается именно то, для чего создана формула, и это здорово! У меня вопрос, и я не могу обдумать это (я новичок в макросах VBA, стараюсь учиться как можно лучше) для результатов в столбце B, все они заканчиваются цифрами с X междуномера. Как бы я изменил свой код, чтобы он удалял эту часть текста? Таким образом, результат будет выглядеть следующим образом:

Как видно из результатов, которые я ищу, по сравнению с приведенными результатами, ###X### вынимается в конце. Я поиграл за пределами VBA и обнаружил, что это работает, но по сути это двухэтапный процесс:

=RIGHT(SUBSTITUTE(A1,"_",CHAR(10),12),LEN(A1)-FIND(CHAR(10),SUBSTITUTE(A1,"_",CHAR(10),12),1)+1)

^^^ Это захватит последний фрагмент строки из A1 (Первое изображение)

=LEFT(A20,MIN(FIND({0,1,2,3,4,5,6,7,8,9},A20&"0123456789")) -1)

^^^ (A20 - это ячейка, которую я использовал в приведенной выше формуле, чтобы получить последний раздел строки в A1) И это удалит все, что находится после самого первого числа. Это работает именно так, как я хочу, но я понятия не имею, с чего начать реализовывать это в формуле VBA выше.

Любая помощь будет принята с благодарностью!

Answer 1

Я также борюсь с подобными формулами, поэтому я использовал регулярные выражения, добавив несколько строк в вашу функцию. Это в основном сопоставление с образцом. Ваш саб так же, как и раньше.

Function StripAfter(ByVal txt As String, ByVal delimiter As String, ByVal occurrence As Long) As String

Dim x As Variant

x = Split(expression:=txt, delimiter:=delimiter, limit:=occurrence + 1)
StripAfter = x(UBound(x))

With CreateObject("VBScript.RegExp")
    .Global = True
    .Pattern = "\d+x\d+$"                                           'match 1+ numbers followed by x followed by 1+ numbers at the end of a string
    If .Test(StripAfter) Then StripAfter = .Replace(StripAfter, "") 'if pattern found replace with empty string
End With

End Function

Answer 2

Вы также можете попробовать:

Option Explicit

Sub test()

    Dim LastRow As Long, i As Long, Chr As Long
    Dim str As String, NewStr As String

    With ThisWorkbook.Worksheets("Sheet1")

        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        For i = 2 To LastRow

            str = .Range("A" & i).Value

            For Chr = 1 To Len(str)

                If Not IsNumeric(Mid(str, Chr, 1)) Then
                    NewStr = NewStr & Mid(str, Chr, 1)
                End If

            Next Chr

            .Range("B" & i).Value = NewStr
            NewStr = ""

        Next i

    End With

End Sub