MyTetra Share
Делитесь знаниями!
Преобразование текстовой строки в двумерный массив
31.12.2017
18:36
Текстовые метки: Текстовые строки, Обработка массивов
Раздел: VBA - Array

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

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

Так же в этом разделе:
 
MyTetra Share v.0.52
Яндекс индекс цитирования