Страницы: 1
RSS
Разделение ячейки по новым строкам
 
Доброго дня.

Очень интересует, есть ли в VBA встроенная функция, которая бы позволяла проанализировать ячейку на предмет новых строк в ней, то есть когда в одной ячейке записаны сразу три строки (каждая с новой строки), и их надо разделить каждую по своей ячейке?

Заранее благодарю. Пример прикреплен, если на словах не совсем понятно..
 
Да, прошу прощения, в примере в третьей ячейке забыл выделить еще одну строку... что-то не заметил  :(
Изменено: AlexTM - 10.07.2015 10:18:41
 
Ищите в тексте Chr(10)
 
"Новая строка" это символ перевода строки, в VBA есть константа vbLf. Соответственно, можно получить массив строк с помощью
Код
myArr = Split(myCell, vbLf)
Изменено: Казанский - 10.07.2015 10:22:00
 
А не сильно затруднит показать строчкой кода на примере одной ячейки? :oops: (для чайника)  
 
На мой способ проверки что-то ругается vba... Ошибка Can't assign to array :(
Код
Sub Das5()
Dim myCell As Range
Set myCell = Worksheets("Пример").Range("A8")
Dim myArr(0 To 10) As String
myArr = Split(myCell, vbLf)
MsgBox myArr(1)
End Sub
Изменено: AlexTM - 10.07.2015 10:36:58
 
Закомментируйте
Dim myArr(0 To 10) As String
Вы задаете размерность, которая может не совпадать с количеством строк в ячейке (количеством элементов, формируемых в Split)
Без явного определения размерности массив сам подстраивается под диапазон.
 
vikttur, СПАСИБО!!! :excl:
 
оставьте просто Dim myArr остальное в строчке удалите
Код
msgbox "в ячейке" & Ubound(myArr)& " строк(а)"
 
V, просто обращение к элементам массива мне удобнее, так копировать в итоге нужно будет, но все равно спасибо за неравнодушие!
 
С трудом вымутил вот такой код:
Код
Sub Das89()
Application.ScreenUpdating = False
On Error Resume Next
Dim StartTime As Date, EndTime As Date
StartTime = Timer
Dim myCell As Range
Dim n As Byte, m As Byte, i As Byte, j As Byte, Z As Byte
For n = 1 To 85
    For m = 1 To 3
        If m = 1 Then Z = 4 Else If m = 2 Then Z = 5 Else If m = 3 Then Z = 7 Else
        j = 0
        For i = 1 To Z - 2
                Set myCell = Worksheets("Пример").Cells(n, m)
                myArr = Split(myCell, vbLf)
                If m = 1 Then Cells(n, i + Z) = myArr(j) Else
                    If m = 2 Then Cells(n, i + Z + 1) = myArr(j) Else
                        If m = 3 Then Cells(n, i + Z + 2) = myArr(j) Else
                    j = j + 1
        Next i
    Next m
Next n
Application.ScreenUpdating = True
EndTime = Timer
MsgBox Format(EndTime - StartTime, "0.0")
End Sub
НО он ОЧЕНЬ долго работает. В таблице больше 27-ми тысяч строк, время выполнения будет порядка 8-ми часов. Можно что-то упростить? :(

Есть подозрение, что это из-за постоянной перезаписи массива... Как бы это упростить...
Изменено: AlexTM - 10.07.2015 14:00:34
 
попробуйте...
Код
Sub ik()
  Dim arIn(), arOut()
  With Sheets("Пример")
    arIn = .Range(.[a8], .Cells(.Rows.Count, "a").End(xlUp).Offset(, 2)).Value
    ReDim arOut(1 To UBound(arIn), 1 To 9)
    For i = 1 To UBound(arIn)
      x = Split(arIn(i, 1), vbLf)
      For j = 0 To UBound(x): arOut(i, 1 + j) = x(j): Next
      x = Split(arIn(i, 2), vbLf)
      For j = 0 To UBound(x): arOut(i, 3 + j) = x(j): Next
      x = Split(arIn(i, 3), vbLf)
      For j = 0 To UBound(x): arOut(i, 6 + j) = x(j): Next
    Next
    .[d8].Resize(UBound(arOut), UBound(arOut, 2)).Value = arOut
  End With
End Sub
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
у меня 100 строк обработалось за 0,17сек.

0,17/100*27000 = 46 сек.
надеюсь, приемлемо.
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
ikki, честно, вообще ничего не понял из Вашего кода, но он работает!!! Мой - это просто какая-то медуза...
Не могли бы написать краткие комментарии по строкам, что там делается? (Я второй третий день VBA сижу изучаю, образования соответствующего не имею, потому и прошу :) )

В любом случае, безмерно благодарен!  :excl: :excl: :idea:
 
гм... ну посмотрите...
там комментировать особо нечего.
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
ikki, спасибо-спасибо, буду изучать-учиться! Спасибо! :idea:
 
Формулы немного медленнее.
Страницы: 1
Читают тему
Наверх