Нужно разбить те числа которые в одной ячейке по разным ячейчам в столбец

[Alexander_Gr]

Привет всем кто смотрит топик! Прошу помочь, пожалуйста кто знает решение моей проблемы.
Есть таблица в Excel огромная около 10000строк. Пример:
Ячейка с цифрами: 3, 4, 5, 6, 7,
В некоторых ячейках: 3-7
В общем числа всякие!

Требуется следующее:
Нужно разбить те числа которые в одной ячейке по разным ячейчам в столбец! Т.е. для примера
Имеем ячейку: 5, 6, 8, 10 (значения в одной ячейке)
Нужно:
5
6
8
10
В разных ячейках встолбец!
Пожалуйста подскажите как это программно сделать, там 10 тыс строк! Просто не реально это сделать вручную, тем более времени очень мало!

Заранее ОЧЕНЬ благодарен тем, кто отзавется!
Спасибо!

[Pavel55]

если у вас в ячейке А1 написано следующие
3, 4, 5, 6, 7, 3-7

То вынести каждую цифру в отдельную ячейку в один столбец, наверное, можно так

Sub Separate()
Dim iCell As Range
Dim i&, n&, iVal$
    Set iCell = Range("A1")
    For i = 1 To Len(iCell)
        iVal = Mid(iCell, i, 1)
        If IsNumeric(iVal) Then
            n = n + 1
            Cells(n, 3) = iVal
        End If
    Next
End Sub

[Alexander_Gr]

Отлично! Спасибо Вам огромное! Еще, хочу сказать, что я только начал изучать VBA поэтому если не сложно предложите пожалуйста универсальный пример не только для одной ячейки а для целого ряда. Допустим с A1 по AN, и что бы можно было менять не только область с 3-7 а например с n-m.
Спасибо большое! Буду разбираться сейчас с этим примером, может до меня и дойдет, сам попробую сделать.
Вы мне очень помогли!

[Alexander_Gr]

Маленькая проблема... результат получается таким:
3
4
5
6
7
3
7

Желательно бы что бы range (3-7) выдавал 3,4,5,6,7, т.е все значения в промежутке.

[Alexander_Gr]

И ещё если ввести отрезок (1-10) то результат получается:

1
1
0

Это немного ни то

[Pavel55]

чтобы макрос вместо 1-10 выдавал 1,2,3,4,5,6,7,8,9,10 мы с вами не договаривались )

[Alexander_Gr]

а иначе зачем тогда 1-10? Можно было и запятой обойтись 1,10.
Но к сожалению тут не последовательность, а диапазон)
Кто знает подскажите пожалуйста как быть в такой ситуации!

[Pavel55]

ну, что же, давайте попробуем продолжить нашу тему, итак, допустим у нас в ячейке А1 такая запись цифр
3, 1-4; 8, 5, 6, 7, 3-7, 1-10, 5, 6
Следующий макрос разобьёт данный код в столбик в столбце С, а также там где у вас есть сокращения типа 1-4, разобьёт на 1, 2, 3, 4 (так же в столбик)

К сожалению макрос обрабатывает только 2-хзначные числа, например, 1-45, но не обработает 1-845!!!

Sub Separate()
Dim iCell As Range
Dim i& 'счётчик каждого символа в строке
Dim n& 'номер строки на листе
Dim iVal As String 'каждое значение
Dim StartValue& 'начальное число перед тире
Dim FinishValue& 'конечное число после тире
Dim MidValue& 'промежуточное значение между двумя числами
Dim iValue2 'позиция второго числа после тире
Dim m& 'счётчик
    Application.ScreenUpdating = False 'отключаем обновление экрана для быстроты работы
    Application.Calculation = xlCalculationManual 'отключаем автопересчёт для быстроты работы

    Set iCell = Range("A1")
    For i = 1 To Len(iCell)
        iVal = Mid(iCell, i, 1)
        'если число
        If IsNumeric(iVal) Then
            n = n + 1
            Cells(n, 3) = iVal
        End If
        'если тире
        If iVal = "-" Then
            StartValue = Mid(iCell, i - 1, 1)
            m = i
            Do
                m = m + 1
                iValue2 = Mid(iCell, m, 1)
            Loop Until Not IsNumeric(iValue2) 'or
            'если второе число состоит из 2-х, например, 10
            If i + 1 <> m - 1 Then
                FinishValue = CLng(Mid(iCell, i + 1, 1) & Mid(iCell, m - 1, 1))
                'прибавляем к счётчику символов 2, чтобы след. раз начать с правильной позиции
                i = i + 2
            Else
                FinishValue = Mid(iCell, m - 1, 1)
                'прибавляем к счётчику символов 1, чтобы след. раз начать с правильной позиции
                i = i + 1
            End If
            MidValue = MidValue + StartValue + 1
            Do
                n = n + 1
                Cells(n, 3) = MidValue
                MidValue = MidValue + 1
            Loop While MidValue - 1 <> FinishValue
        End If
        MidValue = 0
    Next
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    MsgBox "Сделано!"
End Sub

Попробуйте.

[Alexander_Gr]

Ну что ж что то работает. Буду разбираться, может сам дойду до чего-нибудь. В любом случае спасибо вам большое!