Расщепление строки дважды

Question

Я пытаюсь нарезать 400+ строк строк, которые включают буквы и цифры в различные столбцы. Оригинальные строки выглядят примерно так:

Chicago today 1.01 1.33 1.90
Dallas today 1.76
San Antonio today 3.43 4.67 8.99 2.34 9.65 10.13

В идеале мой окончательный код должен содержать названия городов в столбце A и каждый последующий с плавающей точкой в ​​отдельном столбце, например:

 A            B    C   D    E    F    G
Chicago     1.01 1.33 1.90
Dallas      1.76
San Antonio 3.43 4.67 8.99 2.34 9.65 10.13

Я использовал слово «сегодня» в качестве разделителя, потому что оно совсем не важно для конечного продукта, и я смог отделить названия городов от чисел, но теперь все числа существуют в столбце B вместо распределены по столбцам. Я попытался использовать два разделителя: «сегодня» и «», но затем названия городов из двух слов также разделяются.

Sub SplitName ( )

Dim Cpty  As String
Dim i As Integer
Dim Rate As Variant

Cpty = ActiveCell.Value

Rate = Split (City, “today”)

For i = 0 To UBound(Rate)
    Cels(1, i+1).Value = Rate (i)


Next i


End Sub

Любая помощь приветствуется, спасибо!

Answer 1

Еще время поиграть?

1-й шаг: найдите сегодня в строке

2-й шаг: заменить все внешнее пространство специальным (неиспользованным) разделителем

3-й шаг: разделить на этот специальный разделитель

Function SplitCities(ByVal sRow As String) As String()
    Dim today_place As Long
    'Step 1: Look for "today"
    today_place = InStr(sRow, "today")
    'Step 2: Replace the space after today by "|".
    'Since Replace truncate the start of the string, I concatenate it using Left.
    'Here I have removed "today" from the result, but you can use change the values to keep it (use -1 and 0 as offsets)
    sRow = Left$(sRow, today_place - 2) & Replace(sRow, " ", "|", today_place + 5), "|"
    'Step 3: Split the result
    SplitCities = Split(sRow, "|")
End Function

Используйте SplitCities вместо Split в вашем коде.

Answer 2

Могу ли я играть тоже? :)

Мне кажется, это может быть самый быстрый способ?

Logic

1. В столбце 1 заменить «сегодня» на «|»
2. Текст в столбцы в столбце 1 с "|" в качестве разделителя
3. В столбце 2 заменить "" на "|"
4. Текст в столбцы на Col 2 с "|" в качестве разделителя

Код

Sub Sample()
    Dim ws As Worksheet

    Set ws = Sheet1

    With ws
        .Columns(1).Replace What:=" today ", Replacement:="|", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

        .Columns(1).TextToColumns Destination:=.Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="|", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

        .Columns(2).Replace What:=" ", Replacement:="|", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

        .Columns(2).TextToColumns Destination:=.Range("B1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="|", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
        1), Array(6, 1), Array(7, 1)), TrailingMinusNumbers:=True
    End With
End Sub

Скриншот

Answer 3

Как насчет следующего

Пример

Option Explicit
Sub SplitName()
    Dim City As String
        City = ActiveCell.Value

    Dim Rate() As String
        Rate() = Split(City)

    Dim i As Long
    For i = LBound(Rate) To UBound(Rate)
      Debug.Print Rate(i) ' Print to Immediate window
      Cells(1, i + 1).Value = Rate(i)
    Next i

End Sub

Answer 4

Двойной сплит

Дважды разбивает значения ячеек в диапазоне из одного столбца и копирует результат в рассчитанное количество столбцов.

Быстрая версия

Sub SplitName()

    ' Source
    Const cSheet1 As Variant = "Sheet1"   ' Source Sheet Name/Index
    Const cCol As Variant = "A"           ' Source Column Letter/Number
    Const cFirst As Integer = 1           ' Source First Row
    Const cSplit1 As String = "today"     ' First Split String
    Const cSplit2 As String = " "         ' Second Split String
    ' Target
    Const cSheet2 As Variant = "Sheet1"   ' Target Sheet Name/Index
    Const cFirstCell As String = "B1"     ' Target Range First Cell

    Dim vntS As Variant   ' Source Array
    Dim vnt1 As Variant   ' First Split Array
    Dim vnt2 As Variant   ' Second Split Array
    Dim vntT As Variant   ' Target Array
    Dim lastR As Long     ' Source Last Row
    Dim i As Long         ' Arrays Row Counter
    Dim j As Integer      ' Target Array Column Counter

    ' Paste Source Range into Source Array.
    With Worksheets(cSheet1)
        lastR = .Cells(.Rows.Count, cCol).End(xlUp).Row
        vntS = .Range(.Cells(cFirst, cCol), .Cells(lastR, cCol))
    End With

    ' Calculate number of columns in Target Array.
    For i = 1 To UBound(vntS)
        vnt1 = Split(vntS(i, 1), cSplit1)
        vnt2 = Split(Trim(vnt1(1)), cSplit2)
        If j < UBound(vnt2) Then
            j = UBound(vnt2)
        End If
    Next
    ' Increase the number by one because the first column will be the first
    ' string from First Split Array, and by another one because the
    ' Split Arrays are 0-based.
    j = j + 2

    ' Write Source Array to Target Array.
    ReDim vntT(1 To UBound(vntS), 1 To j)
    For i = 1 To UBound(vntS)
        vnt1 = Split(vntS(i, 1), cSplit1)
        vnt2 = Split(Trim(vnt1(1)), cSplit2)
        vntT(i, 1) = Trim(vnt1(0))
        For j = 0 To UBound(vnt2)
            vntT(i, j + 2) = vnt2(j)
        Next
    Next

    ' Paste Target Array into Target Range calculated from Target First Cell.
    With Worksheets(cSheet2).Range(cFirstCell)
        .Resize(UBound(vntT), UBound(vntT, 2)) = vntT
    End With

End Sub

Просто обновление данного кода

Sub SplitName()

    Dim Cpty  As String
    Dim i As Integer
    Dim Rate As Variant
    Dim Rate2 As Variant

    Cpty = ActiveCell.Value

    Rate = Split(Cpty, "today")
    Rate2 = Split(Trim(Rate(1))) ' ***

    ' Write City
    Cells(1, 2).Value = Trim(Rate(0))

    ' Write Numbers
    For i = 0 To UBound(Rate2)
        Cells(1, i + 3).Value = Rate2(i)
    Next i

End Sub

*** Второй разделитель пропущен, поскольку по умолчанию используется значение "".

Answer 5

Разделите на "сегодня", затем разделите секунду (1 в 1-D массиве с нулями) на пространство и убедитесь, что вы получаете двойные, а не текст, который выглядит только как двойные.

Chicago today 1.01 1.33 1.90
Dallas today 1.76
San Antonio today 3.43 4.67 8.99 2.34 9.65 10.13

for i=1 to lastrow
    arr1 = split(rasnge("A" & i), " today ")
    arr2 = split(arr1(1), " ")
    for j = lbound(arr2) to ubound(arr2)
        debug.print cdbl(arr2(j))
    next j
next i