Страницы: 1
RSS
Разделить текст, с разным количеством разделителей, по строкам макросом
 
Добрый день! Помогите написать фрагмент макроса.
Есть столбец с текстом в ячейках, вида А-Б-В-Г-Д-1-Е-Ж-З  и  А-Б-В-Г-Д-Е-Ж-З. Нужно разбить текст по разделителю "-". Общее количество символов в ячейке, а также количество символов между разделителями может быть разное. Количество разделителей всегда семь или восемь. "Лишний" фрагмент всегда шестой. Написал такой макрос:
Код
Sub мак()

Dim lLastRow As Long
lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row).TextToColumns Destination:=Range("C2"), _
       OtherChar:="-", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
        1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1))
End Sub

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

Помогите довести код макроса до рабочего состояния. Спасибо.
 
casag, можно добавить цикл нахождения последнего занятого столбца и вставки пустых ячеек.
Код
Sub Мак()
'
Dim lLastRow As Long, i As Long, j As Long
lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Range("A2:A" & lLastRow).TextToColumns Destination:=Range("C2"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="-", FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2), Array(5, _
        2), Array(6, 2), Array(7, 2), Array(8, 2), Array(9, 2)), TrailingMinusNumbers:=True
    Application.CutCopyMode = False
    Application.ScreenUpdating = False
    For i = 2 To lLastRow
      j = Cells(i, Columns.Count).End(xlToLeft).Column
      If j < 11 Then Cells(i, 8).Resize(, 11 - j).Insert xlShiftToRight
    Next
    Application.ScreenUpdating = True
End Sub
 
Спасибо огромное. Буду изучать. Практика лучшая школа.
 
Здравствуйте. А можно еще вот так, на массивах:
Скрытый текст
Кому решение нужно - тот пример и рисует.
 
А еще можно формулой удвоить минус в нужной позиции и разбивать текст как обычно
Код
Sub Мак1()
'
Dim lLastRow As Long
  lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
  With Range("C2:C" & lLastRow)
    .NumberFormat = "General"
    .Formula = "=IF(LEN(A2)-LEN(SUBSTITUTE(A2,""-"",""""))<8,SUBSTITUTE(A2,""-"",""--"",5),A2)"
    .Value = .Value
    .TextToColumns Destination:=Range("C2"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="-", FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2), Array(5, _
        2), Array(6, 2), Array(7, 2), Array(8, 2), Array(9, 2)), TrailingMinusNumbers:=True
  End With
End Sub
 
Пытливый, Спасибо и вам огромное. Кроме практической пользы еще и хороший пример для изучения массивов.

Казанский, Спасибо, с формулой тоже очень изящно. Возьму на заметку.
Изменено: casag - 16.10.2018 16:40:16
Страницы: 1
Наверх