Отделение строк от чисел с помощью Excel VBA

Question

Мне нужно

a) отделить строки от чисел для выбора ячеек

и

b) поместить разделенные строки и числа в разные столбцы.

Например, лист Excel выглядит следующим образом:

     A1          B1
  100CASH     etc.etc.

Результат должен быть:

   A1            B1          C1
  100           CASH       etc.etc.

Использование регулярных выражений будет полезно, так как могут быть разные ячейкиформаты, такие как 100-CASH, 100 / CASH, 100% CASH.Как только процедура настроена, не составит труда использовать регулярные выражения для различных вариантов.

Я наткнулся на UDF для извлечения чисел из ячейки.Это можно легко изменить, чтобы извлечь строки или другие типы данных из ячеек, просто изменив регулярное выражение.

Но мне нужен не просто UDF, а вспомогательная процедура для разделения ячеек с использованием регулярных выражений и размещения разделенныхданные в отдельные столбцы.

Я также нашел похожий вопрос в SU , однако это не VBA.

Answer 1

Посмотрите, будет ли это работать для вас:

ОБНОВЛЕНО 11/30:

Sub test()

    Dim RegEx As Object
    Dim strTest As String
    Dim ThisCell As Range
    Dim Matches As Object
    Dim strNumber As String
    Dim strText As String
    Dim i As Integer 
    Dim CurrCol As Integer


    Set RegEx = CreateObject("VBScript.RegExp")
    ' may need to be tweaked
    RegEx.Pattern = "-?\d+"

    ' Get the current column
    CurrCol = ActiveCell.Column

    Dim lngLastRow As Long
    lngLastRow = Cells(1, CurrCol).End(xlDown).Row

    ' add a new column & shift column 2 to the right
    Columns(CurrCol + 1).Insert Shift:=xlToRight

    For i = 1 To lngLastRow  ' change to number of rows to search
        Set ThisCell = ActiveSheet.Cells(i, CurrCol)
        strTest = ThisCell.Value
        If RegEx.test(strTest) Then
            Set Matches = RegEx.Execute(strTest)
            strNumber = CStr(Matches(0))
            strText = Mid(strTest, Len(strNumber) + 1)
            ' replace original cell with number only portion
            ThisCell.Value = strNumber
            ' replace cell to the right with string portion
            ThisCell.Offset(0, 1).Value = strText
        End If
    Next

    Set RegEx = Nothing
End Sub

Answer 2

Как насчет:

Sub UpdateCells()
Dim rng As Range
Dim c As Range
Dim l As Long
Dim s As String, a As String, b As String

''Working with sheet1 and column C
With Sheet1
    l = .Range("C" & .Rows.Count).End(xlUp).Row
    Set rng = .Range("C1:C" & l)
End With

''Working with selected range from above
For Each c In rng.Cells
    If c <> vbNullString Then
        s = FirstNonNumeric(c.Value)

        ''Split the string into numeric and non-numeric, based
        ''on the position of first non-numeric, obtained above. 
        a = Mid(c.Value, 1, InStr(c.Value, s) - 1)
        b = Mid(c.Value, InStr(c.Value, s))

        ''Put the two values on the sheet in positions one and two 
        ''columns further along than the test column. The offset 
        ''can be any suitable value.
        c.Offset(0, 1) = a
        c.Offset(0, 2) = b
    End If
Next
End Sub

Function FirstNonNumeric(txt As String) As String
    With CreateObject("VBScript.RegExp")
        .Pattern = "[^0-9]"
        FirstNonNumeric = .Execute(txt)(0)
    End With
End Function