Function Text2Array(ByVal txt$, Optional ByVal ColumnsSeparator$ = " ", _

                    Optional ByVal RowsSeparator$ = vbNewLine) As Variant

    ' получает в качестве параметров текстовую строку TXT,

    ' и разделители строк и столбцов для разбиваемой строки

    ' Возвращает двумерный массив - результат разбиения строки

    txt = Trim(txt): On Error Resume Next: Err.Clear

    If txt Like "*" & RowsSeparator$ Then txt = Left(txt, Len(txt) - Len(RowsSeparator$))

    tmpArr1 = Split(txt, RowsSeparator$): RowsCount = UBound(tmpArr1) + 1

    ColumnsCount = UBound(Split(tmpArr1(0), ColumnsSeparator$)) + 1

    If Err.Number > 0 Then MsgBox "Строка не может быть разбита на двумерный массив", vbCritical: End

    ReDim Arr(1 To RowsCount, 1 To ColumnsCount)

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

        tmpArr2 = Split(Trim(tmpArr1(i)), ColumnsSeparator$)

        For j = 1 To ColumnsCount

            Arr(i + 1, j) = tmpArr2(j - 1)

        Next j

    Next i

    Text2Array = Arr

End Function

• 11658 просмотров
• 
  

Учусь! Никакого проекта нет, все только в планах. Думаю с какой стороны подойти.
На данный момент интересует вот чно.
В ячейке (B1...Bn+1) строка типа "Болт (обработанный 20\80 4356, крашенный 20\100 7652, конический 20\120 6743, скошенный 30\150 98711)"
Надо разбить в разные ячейки:
4356|Болт обработанный||20\80
7652|Болт крашенный||20\100
и т.д.

Вам помогут следующие функции и макросы:

Sub ПримерИспользования()

    txt$ = "Болт (обработанный 20\80 4356, крашенный 20\100 7652, конический 20\120 6743, скошенный 30\150 98711)"

    arr = SplitText(txt)

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

        MsgBox arr(i), , "Часть " & i

    Next i

End Sub

Sub ОбработатьВсеЯчейки()

    On Error Resume Next

    Dim cell As Range, ra As Range: Application.ScreenUpdating = False

    Set ra = Range([B1], Range("B" & Rows.Count).End(xlUp))

    For Each cell In ra.Cells    ' перебираем все заполненные ячейки в столбце B

        ' разбираем ячейку на несколько, результат помещаем в ячейку справа (в столбцы 3,4,5 и т.д.)

        arr = SplitText(cell)

        If IsArray(arr) Then cell.Next.Resize(, UBound(arr) + 1).Value = arr

    Next cell

End Sub

Function SplitText(ByVal txt$) As Variant

    On Error Resume Next

    txt1$ = Trim(Split(txt, "(")(0))    ' текст до скобок

    txt2$ = Trim(Split(Split(txt, ")")(0), "(")(1))    ' текст после скобок

    arr = Split(txt2, ", ")    ' разбиваем текст из скобок на части

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

        ' формируем итоговую строку

        arr(i) = Split(arr(i))(2) & "|" & txt1 & " " & Split(arr(i))(0) & "||" & Split(arr(i))(1)

        ' Debug.Print i, arr(i)

    Next i

    SplitText = arr    ' возвращаем результат разбиения

End Function

Первый макрос покажет вам пример разбиения текстовой строки,
второй - обработает всю вашу таблицу, разбив текст на ячейки,
а функция SplitText - основа для этих макросов.

Из приведённой вами текстовой строки, функция возвращает одномерный массив из 4 элементов:

0 = 4356|Болт обработанный||20\80
1 = 7652|Болт крашенный||20\100
2 = 6743|Болт конический||20\120
3 = 98711|Болт скошенный||30\150

• ответить