Перевод массива чисел из произвольной записи в отдельные ячейки

[luu]

Есть ли возможность перевести данные, записанные в произвольном порядке в виде последовательности чисел (через запятую, используя тире и т.п.) в массив данных, записанных по одному числу?
Пример в приложенном файле. Есть запись в виде как показано в столбцах A и B, нужно получить в виде, записанном в столбцах D и E

[sokol92]

Такие одноразовые задачи сейчас успешно решает искусственный интеллект.
Если задача носит постоянный характер, то придется писать макрос.

[luu]

Такие одноразовые задачи сейчас успешно решает искусственный интеллект.
Если задача носит постоянный характер, то придется писать макрос.

Задачка постоянная. Сейчас пользователю приходится руками проводить такую операцию. Хочется автоматизировать

[bigor]

Смотрите похожее , есть даже формульное решение, но там решается только часть вашей задачи

[economist]

Быстрее всего это делается в Python+Pandas, доступны в LO.

[sokol92]

Макрос см. ниже (и в приложенном файле).
При изменении размера результирующего диапазона формулу массива нужно из результирующего диапазона (G2:G41) удалить, выделить ячейку G2 и ввести формулу массива вновь.

Код Выделить Развернуть

Option Explicit

' Размножает строки диапазона aRg согласно списку в последнем столбце (неотрицательные целые числа или диапазоны)
Function ConvertList(aRg)
  Dim res, arr, arr2, i As Long, n As Long, j As Long, ires As Long, ub2 As Long, i1 As Long, i2 As Long, v
 
  ' aRg - двумерный массив (строка, столбец), индексы от 1 !
  n=999
  ub2=UBound(aRg, 2)
  ReDim res(1 To n, 1 To ub2)
 
  For i=1 To UBound(aRg, 1) ' цикл по строкам

    arr=Split(aRg(i, ub2), ",")  ' список целых чисел
    For Each v In arr            ' цикл по элементам списка
      arr2=Split(Trim(v), "-", 2)
      i1=0
      i2=-1
      If Ubound(arr2)=0 Then
        If IsNumeric(arr2(0)) Then
          i1=Clng(arr2(0))
          i2=i1
        End If
      ElseIf Ubound(arr2)=1 Then
        If IsNumeric(arr2(0)) And IsNumeric(arr2(1)) Then 
          i1=Clng(arr2(0))
          i2=Clng(arr2(1))
        End If
      End If
     
      Do While i1<=i2
        ires=ires+1
        If ires>n Then
          n=n*2
          ReDim Preserve res(1 To n, 1 To ub2)
        End If
       
        res(ires, ub2)=i1
        For j=1 To ub2-1
          res(ires, j)=aRg(i, j)
        Next j
     
        i1=i1+1
      Loop   
    Next v 
  Next i
 
  If ires>0 Then
    ReDim Preserve res(1 to ires, 1 to ub2)
  Else
    res=Array()
  End If   
 
  ConvertList=res
End Function

Sub TestConvertList
  Dim arr(1 To 2, 1 To 2), res
  arr(1, 1)="Мск-1"
  arr(1, 2)="1, 2-3,5, 8"
  arr(2, 1)="Екб-2"
  arr(2, 2)="10-12,23-27"
  res=ConvertList(arr)
End Sub
Кстати, в Excel VBA этот макрос тоже будет работать, только нужно заменить операторы Redim Preserve, так как в VBA допустимо менять только последнее измерение массива.