0

В общем, у меня есть некоторые строки, в которых находятся словосочетания, разделённые #. Выглядит примерно так: голубое небо#зелёная трава#оранжевые апельсины#апельсиновая оранжевость Мне нужно, чтобы когда скрипт наткнётся на # в ячейке, он переносил оставшееся на строку ниже, снова натыкался, снова на строку ниже. И так до тех пор, пока # не останется. То есть, чтобы 4 словосочетания через # таким образом в итоге давали 4 строки.

Если это невозможно средствами языка, тогда как узнать порядковый номер символа в ячейке? Я так обрежу.

1
  • Идете по строкам и проверяете на условие InStr("Tech on#the Net", "T")>0 -> Result: 8, затем функцией LEFT() вырезаете часть строки до найденного символа и RIGHT() после в этой части повторяете InStr. Затем вставляете Worksheets.Rows(row#).Insert строк сколько нужно и в нужные ячейки вырезанные LEFT()'ом строки Commented 25 окт. 2018 в 9:18

4 ответа 4

2
Sub FindSymbol()
Dim aData(), aSpl
Dim lRw As Long, i As Long, k As Long, j As Long
    With Worksheets("sheet1") ' лист с исходными данными'
        lRw = .Cells(.Rows.Count, 1).End(xlUp).Row 'последняя строка с данными в столбце А'
        aData = .Range("A1:A" & lRw).Value ' тексты заносим в массив'
    End With

    ' определяем (с запасом) размерность массива результата'
    ReDim aRes(1 To lRw * 5, 1 To 1) ' 5 - макс к-во фрагментов в текстах'

    For i = 2 To lRw ' цикл по текстам, начиная со стоки 2'
        aSpl = Split(aData(i, 1), "#")  ' расщепляем на фрагменты'

        For j = 0 To UBound(aSpl)
            k = k + 1: aRes(k, 1) = aSpl(j)  ' записываем фрагменты в массив результата'
        Next j
    Next i

    With Worksheets("sheet1") ' лист для выгрузки'
        .Columns(3).ClearContents ' чистим столбец С'
        .Range("C2").Resize(k, 1).Value = aRes ' выгружаем результат в столбец С'
    End With

    MsgBox "OK", 64, "" ' радуемся :)'
End Sub

Для выгрузки в исходный диапазон вместо последнего блока With/End With записать строку

Worksheets("sheet1").Range("A2").Resize(k, 1).Value = aRes ' выгружаем результат в столбец A'

Можно формулой.

  • Для одной ячейки, результат по строкам:

    =СЖПРОБЕЛЫ(ПСТР(ПОДСТАВИТЬ("#"&$A$2;"#";ПОВТОР(" ";99));СТРОКА(A1)*99;99))

  • Для диапазона ячеек, результат по столбцам:

    =СЖПРОБЕЛЫ(ПСТР(ПОДСТАВИТЬ("#"&$A2;"#";ПОВТОР(" ";99));СТОЛБЕЦ(A1)*99;99))

Хотя для разнесения по столбцам можно проще - применить инструмент

Данные-Текст_по_столбцам-С_разделителем

  • Для диапазона ячеек, результат по строкам.

В доп. столбце находим количество фрагментов для подсказки основной формуле: в первой строке диапазона - 1, ниже формула

=ДЛСТР(A2)-ДЛСТР(ПОДСТАВИТЬ(A2;"#";))+1+B2

Результат:

=СЖПРОБЕЛЫ(ПСТР(ПОДСТАВИТЬ("#"&ИНДЕКС($A$2:$A$20;ПОИСКПОЗ(СТРОКА(A1);$B$2:$B$20));"#";ПОВТОР(" ";99));(СТРОКА(A1)-ИНДЕКС($B$2:$B$20;ПОИСКПОЗ(СТРОКА(A1);$B$2:$B$20))+1)*99;99))

введите сюда описание изображения

1
  • Спасибо. Я уже нашёл решение наилучшим образом удовлетворяющее мои потребности. Commented 26 окт. 2018 в 4:06
1
Sub split_by_diez()
Dim tmp As Range, cnt As Integer
Set tmp = ActiveSheet.Range("A1") ' Первая ячейка колонки
cnt = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
Do Until tmp.Row > cnt
    If InStr(tmp.Value, "#") Then
        tmp.Insert xlShiftDown
        tmp.Offset(-1, 0).Value = Left(tmp.Value, InStr(tmp.Value, "#") - 1)
        tmp.Value = Mid(tmp.Value, InStr(tmp.Value, "#") + 1)
        cnt = cnt + 1
    Else
        Set tmp = tmp.Offset(1, 0)
    End If
Loop
End Sub
1
  • Спасибо. Я уже нашёл решение наилучшим образом удовлетворяющее мои потребности. Commented 26 окт. 2018 в 4:05
1
Sub Проверить_Строки()
Dim sh As Worksheet
Set sh = ThisWorkbook.Worksheets("Лист1")
nRow = sh.Cells(sh.Rows.Count, 1).End(xlUp).Row 'в первом столбце последняя не пустая строка
'бежим по столбцу и ищем ячеики со знаком #
For i = nRow To 1 Step -1
    If InStr(1, sh.Cells(i, 1), "#") > 0 Then
        masStr = Split(sh.Cells(i, 1), "#")
        For k = 0 To UBound(masStr)
            If k = 0 Then
                sh.Cells(i, 1).FormulaR1C1 = masStr(k)
            Else
                sh.Rows(i + k).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 'добавляем пустую ниже
                sh.Cells(i + k, 1).FormulaR1C1 = masStr(k)
            End If
        Next
    End If

Next
end sub
2
  • 1
    пример файла yadi.sk/d/XXdPv1t9WUIgWg
    – SergeyE
    Commented 25 окт. 2018 в 11:02
  • Спасибо. Я уже нашёл решение наилучшим образом удовлетворяющее мои потребности. Commented 26 окт. 2018 в 4:05
0

Всем ответившим спасибо, ваши варианты с 90% вероятностью работают, но я полагаю, что чем проще код, тем лучше. Поэтому нашёл для себя лучшее решение. Его и прилагаю.

Sub Sabaqa()
Dim array1() As String
Dim posStr As Long
Dim r As Integer
posStr = Cells(1, 1).End(xlDown).Row
r = posStr
Range("B1").value = posStr
For i2 = 1 To posStr
    var = ActiveCell.value
    array1 = Split(var, "#")
    arvalue = UBound(array1)

    For i = 0 To arvalue
        ActiveCell.value = array1(i)
        ActiveCell.Offset(1, 0).Select
        Selection.EntireRow.Insert
    Next i
Selection.EntireRow.Delete
Next i2
6
  • ваши варианты с 90% вероятностью работают Пожалуйста, подтвердите конкретными примерами не-работы оставшиеся 10%.
    – Akina
    Commented 26 окт. 2018 в 4:36
  • Прошу не путать 90% случаев и 90% вероятности. Я говорю это к тому, что я их не тестил, но почти полностью уверен что они рабочие. Commented 27 окт. 2018 в 3:44
  • "Пастернака не читал, но осуждаю!"...
    – Akina
    Commented 29 окт. 2018 в 4:50
  • Да кто осуждает-то? Я просто допускаю, что один или несколько вариантов работать не станут. ДО-ПУ-СКА-Ю. Я не говорю, что они убогие и не работают. Я не осуждаю их. Решительно не понимаю, почему Вы так уверены, что я априори настроен против Вас. Commented 30 окт. 2018 в 6:19
  • Я не говорю о настрое. Я о том, что технический специалист должен оперировать проверенными фактами, а не облыжными домыслами.
    – Akina
    Commented 30 окт. 2018 в 6:26

Ваш ответ

Нажимая «Отправить ответ», вы соглашаетесь с условиями пользования и подтверждаете, что прочитали политику конфиденциальности.

Всё ещё ищете ответ? Посмотрите другие вопросы с метками или задайте свой вопрос.