Преобразование текстовой строки в двумерный массив

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

14758 просмотров

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

l_anton, 24 Янв 2014 - 09:41.#1

Добрый день, ищу решение обратной задачи. Преобразование двумерного массива в одномерный. Может кто-нибудь подсказать или дать ссылочку

Гость, 9 Окт 2012 - 11:11.#2

Кстати, как вариант, вместо
ColumnsCount = UBound(Split(tmpArr1(0), ColumnsSeparator$)) + 1

прописать
For i = LBound(tmpArr1) To UBound(tmpArr1)
ColumnsCount = IIf(UBound(Split(tmpArr1(i), ColumnsSeparator)) + 1 > ColumnsCount, UBound(Split(tmpArr1(i), ColumnsSeparator)) + 1, ColumnsCount)
Next i

тогда в случае следующей строки

123 123
321 321 321

кол-во столбцов будет = 3, а не 2, как в предыдущем случае, что вроде как правильней

Гость, 9 Окт 2012 - 10:51.#3

А зачем строка
If txt Like "*" & RowsSeparator$ Then txt = Left(txt, Len(txt) - Len(RowsSeparator$))

Игорь (администратор сайта), 8 Сен 2012 - 06:24.#4

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

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

Гость, 7 Сен 2012 - 23:22.#5

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

Игорь (администратор сайта), 7 Сен 2012 - 22:07.#6

Здравствуйте, Дмитрий.
Откуда я знаю, как должно быть, и где у вас пробел встречается.
Покажите свой код, скажите, что пытаетесь сделать, - тогда подскажу вам, как правильно написать код.

Гость, 7 Сен 2012 - 22:04.#7

У меня когда встречает пробел, просто удаляет все после пробела (вместе с пробелом).
Так и должно быть?

Гость, 15 Фев 2011 - 15:45.#8

Где так прогать научится, ато на работе по мелочи макросы нужны. Человек шарит, молодец. :-)

Отправить комментарий

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.

Преобразование текстовой строки в двумерный массив

Комментарии

Настройки просмотра комментариев

Отправить комментарий

НАДСТРОЙКИ ДЛЯ EXCEL