Цикл с условием.Делать до конца номера

Question

У меня есть ячейка с полным адресом.Я хочу скопировать название улицы и номер улицы в следующую ячейку.Например, "STRANDVEJEN 100 MIDDELFART DENMARK"

В этом примере я хочу скопировать "STRANDVEJEN 100".

В настоящее время все копируется в следующую ячейку.Но мне нужен совет, как продолжить

Sub move()
    Range("C3:C2000").Copy Range("D3:D2000")
    Do until......
End Sub

Мне нужна помощь с до до части.

Answer 1

Попробуйте:

Option Explicit

Sub CopyYes()

    Dim arr As Variant, strSplit As Variant
    Dim i As Long

    With ThisWorkbook.Worksheets("Sheet1")

        arr = .Range("C3:C2000")

        For i = LBound(arr) To UBound(arr)

            strSplit = Split(arr(i, 1), " ")

            .Range("E" & i + 2).Value = strSplit(0)

            .Range("F" & i + 2).Value = strSplit(1)

        Next i

    End With

End Sub

Результаты:

Answer 2

Вот функция, которая будет выполнять ваш «разрез» на строку. Это не красиво, и, без сомнения, лучше написать с помощью простой команды reg-ex, но ..

Function untilnumeric(txt As String) As String
    Dim i As Long
    Dim started As Boolean
    For i = 1 To Len(txt)
        If Asc(Mid(txt, i, 1)) > 47 And Asc(Mid(txt, i, 1)) < 58 Then
            started = True
        Else
            If started = True And Asc(Mid(txt, i, 1)) = 32 Then
                untilnumeric = Left(txt, i - 1)
                Exit For
            End If
        End If
    Next
End Function

Вы можете использовать его следующим образом для столбца C - скопировать результат в D:

Range("D3:D2000").Value = Range("C3:C2000").Value
For Each c In Range("D3:D2000").Cells
    c.Value = untilnumeric(c.Value)
Next

Примечание: слегка изменено, чтобы поднять любые буквы в числовой части. eg.100A