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))