Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Составить диаппазон из ряда чисел - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Составить диаппазон из ряда чисел
and_evg Дата: Среда, 13.09.2023, 11:28 | Сообщение № 1
Группа: Проверенные
Ранг: Обитатель
Сообщений: 460
Репутация: 77 ±
Замечаний: 0% ±

Excel 2007
Всем доброго времени суток.
Столкнулся со следующей задачей, и что то случился затык... (решений обратной задачи много но вот этой так и не нашёл)
Имеется некий ряд чисел (без разницы в столбик или в строку), отсортированных по возрастанию Например:
1
2
3
5
7
9
10
11

а необходимо поучить строку вида: 1-3, 5, 7, 9-11
Интересно бы посмотреть решение как формулами, так и на VBA
Заранее спасибо.
К сообщению приложен файл: Diappazon.xls (27.0 Kb)


Сообщение отредактировал and_evg - Среда, 13.09.2023, 11:29
 
Ответить
СообщениеВсем доброго времени суток.
Столкнулся со следующей задачей, и что то случился затык... (решений обратной задачи много но вот этой так и не нашёл)
Имеется некий ряд чисел (без разницы в столбик или в строку), отсортированных по возрастанию Например:
1
2
3
5
7
9
10
11

а необходимо поучить строку вида: 1-3, 5, 7, 9-11
Интересно бы посмотреть решение как формулами, так и на VBA
Заранее спасибо.

Автор - and_evg
Дата добавления - 13.09.2023 в 11:28
Nic70y Дата: Среда, 13.09.2023, 11:50 | Сообщение № 2
Группа: Друзья
Ранг: Экселист
Сообщений: 8972
Репутация: 2356 ±
Замечаний: 0% ±

Excel 2010
вариант - две формулы в доп.столбце

АпДэйт
добавил УДФ

так короче
[vba]
Код
Function u_4(u As Range)
    u_4 = u(1)
    For b = 2 To u.Count
        If u(b + 1) - u(b) = 1 And u(b) - u(b - 1) = 1 Then
            d = ""
        Else
            c = ", "
            If u(b) - u(b - 1) = 1 Then c = "-"
            d = c & u(b)
        End If
        u_4 = u_4 & d
    Next
End Function
[/vba]
К сообщению приложен файл: 96_1.xlsm (15.1 Kb)


ЮMoney 41001841029809

Сообщение отредактировал Nic70y - Среда, 13.09.2023, 13:40
 
Ответить
Сообщениевариант - две формулы в доп.столбце

АпДэйт
добавил УДФ

так короче
[vba]
Код
Function u_4(u As Range)
    u_4 = u(1)
    For b = 2 To u.Count
        If u(b + 1) - u(b) = 1 And u(b) - u(b - 1) = 1 Then
            d = ""
        Else
            c = ", "
            If u(b) - u(b - 1) = 1 Then c = "-"
            d = c & u(b)
        End If
        u_4 = u_4 & d
    Next
End Function
[/vba]

Автор - Nic70y
Дата добавления - 13.09.2023 в 11:50
AlienSphinx Дата: Среда, 13.09.2023, 11:56 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 24
Репутация: 6 ±
Замечаний: 0% ±

PQ (upd - в строку то я забыл финишировать...)
[vba]
Код
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    idx = Table.AddIndexColumn(Source, "idx", 1, 1, Int64.Type),
    g =
        Table.Group(
            idx, {"numbers", "idx"},
            {{"диаППазон", each Text.Combine(List.Transform(List.Distinct({List.Min(_[numbers]), List.Max(_[numbers])}), Text.From), "-")}},
            GroupKind.Local,
            (s, c) => Byte.From((c[numbers] - s[numbers]) <> (c[idx] - s[idx]))
        )[диаППазон],
    string = Text.Combine(g, ", ")
in
    string
[/vba]
К сообщению приложен файл: 987.xlsx (17.0 Kb)


Сообщение отредактировал AlienSphinx - Среда, 13.09.2023, 12:45
 
Ответить
СообщениеPQ (upd - в строку то я забыл финишировать...)
[vba]
Код
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    idx = Table.AddIndexColumn(Source, "idx", 1, 1, Int64.Type),
    g =
        Table.Group(
            idx, {"numbers", "idx"},
            {{"диаППазон", each Text.Combine(List.Transform(List.Distinct({List.Min(_[numbers]), List.Max(_[numbers])}), Text.From), "-")}},
            GroupKind.Local,
            (s, c) => Byte.From((c[numbers] - s[numbers]) <> (c[idx] - s[idx]))
        )[диаППазон],
    string = Text.Combine(g, ", ")
in
    string
[/vba]

Автор - AlienSphinx
Дата добавления - 13.09.2023 в 11:56
and_evg Дата: Среда, 13.09.2023, 13:38 | Сообщение № 4
Группа: Проверенные
Ранг: Обитатель
Сообщений: 460
Репутация: 77 ±
Замечаний: 0% ±

Excel 2007
Nic70y, AlienSphinx, Спасибо за интересные решения
 
Ответить
СообщениеNic70y, AlienSphinx, Спасибо за интересные решения

Автор - and_evg
Дата добавления - 13.09.2023 в 13:38
msi2102 Дата: Среда, 13.09.2023, 17:25 | Сообщение № 5
Группа: Проверенные
Ранг: Обитатель
Сообщений: 415
Репутация: 129 ±
Замечаний: 0% ±

Excel 2007
Посмотрите ТУТ, там есть ссылки на подобные темы
 
Ответить
СообщениеПосмотрите ТУТ, там есть ссылки на подобные темы

Автор - msi2102
Дата добавления - 13.09.2023 в 17:25
Pelena Дата: Среда, 13.09.2023, 18:21 | Сообщение № 6
Группа: Админы
Ранг: Местный житель
Сообщений: 19373
Репутация: 4531 ±
Замечаний: ±

Excel 365 & Mac Excel
там есть ссылки на подобные темы

там ссылки ведут в основном на этот форум))
Есть ещё готовое решение Получение интервалов из числовой последовательности


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
Сообщение
там есть ссылки на подобные темы

там ссылки ведут в основном на этот форум))
Есть ещё готовое решение Получение интервалов из числовой последовательности

Автор - Pelena
Дата добавления - 13.09.2023 в 18:21
bmv98rus Дата: Среда, 13.09.2023, 21:09 | Сообщение № 7
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4112
Репутация: 769 ±
Замечаний: 0% ±

Excel 2013/2016

там ссылки ведут в основном на этот форум))
ну надо же как то мир на планете поддержать :D


Замечательный Временно просто медведь , процентов на 20.
 
Ответить
Сообщение

там ссылки ведут в основном на этот форум))
ну надо же как то мир на планете поддержать :D

Автор - bmv98rus
Дата добавления - 13.09.2023 в 21:09
Gustav Дата: Среда, 13.09.2023, 21:56 | Сообщение № 8
Группа: Админы
Ранг: Участник клуба
Сообщений: 2775
Репутация: 1146 ±
Замечаний: ±

начинал с Excel 4.0, видел 2.1
В очередной раз (лень искать предыдущие случаи) добавлю свои пять копеек в виде нетрадиционной экзотики, когда можно все необходимые расчеты переложить на внутреннюю эксельную арифметику диапазонов, делая "снаружи" только вызовы соответствующих методов и компоновку генерируемого материала.
[vba]
Код
Sub generate_IntRanges_By_ExcelRanges()
    Dim rngSrc As Range, rng As Range, area As Range, str As String, arr, item
    
    Set rngSrc = Range("A1:A8") 'диапазон исходных данных (числа в столбик)
    
    arr = Split("A" & Replace(Join(Application.Transpose(rngSrc), ","), ",", ",A"), ",")
    Set rng = Range(arr(0))
    For Each item In arr
        Set rng = Union(rng, Range(item))
    Next
    For Each area In rng.Areas
        str = str & "," & area.Address(0, 0)
    Next
    str = Replace(Replace(Mid(str, 2), ":", "-"), "A", "")
    
    Debug.Print str 'строка результата: 1-3,5,7,9-11
End Sub
[/vba]
По шагам внутри процесса получаются примерно следующие трансформации:
[vba]
Код
1,2,3,5,7,9,10,11
A1,A2,A3,A5,A7,A9,A10,A11
A1:A3,A5,A7,A9:A11
1-3,5,7,9-11
[/vba]
Метод не то, чтобы самый краткий и быстрый, но, согласитесь, по-своему прикольный. Разумеется, со всеми естественными ограничениями Excel (типа миллион строк и т.п.).

[p.s.]Если нужна аналогичная функция рабочего листа (UDF), то оформляется на раз (добавлен пробел после запятой):[/p.s.]
[vba]
Код
Function ЦЕЛЫЕ_ДИАПАЗОНЫ(rngSrc As Range) As String
    Dim rng As Range, area As Range, str As String, arr, item
    arr = Split("A" & Replace(Join(Application.Transpose(rngSrc), ","), ",", ",A"), ",")
    Set rng = Range(arr(0))
    For Each item In arr
        Set rng = Union(rng, Range(item))
    Next
    For Each area In rng.Areas
        str = str & ", " & area.Address(0, 0)
    Next
    ЦЕЛЫЕ_ДИАПАЗОНЫ = Replace(Replace(Mid(str, 3), ":", "-"), "A", "")
End Function
[/vba]


МОИ: Ник, Tip box: 41001663842605

Сообщение отредактировал Gustav - Среда, 13.09.2023, 22:38
 
Ответить
СообщениеВ очередной раз (лень искать предыдущие случаи) добавлю свои пять копеек в виде нетрадиционной экзотики, когда можно все необходимые расчеты переложить на внутреннюю эксельную арифметику диапазонов, делая "снаружи" только вызовы соответствующих методов и компоновку генерируемого материала.
[vba]
Код
Sub generate_IntRanges_By_ExcelRanges()
    Dim rngSrc As Range, rng As Range, area As Range, str As String, arr, item
    
    Set rngSrc = Range("A1:A8") 'диапазон исходных данных (числа в столбик)
    
    arr = Split("A" & Replace(Join(Application.Transpose(rngSrc), ","), ",", ",A"), ",")
    Set rng = Range(arr(0))
    For Each item In arr
        Set rng = Union(rng, Range(item))
    Next
    For Each area In rng.Areas
        str = str & "," & area.Address(0, 0)
    Next
    str = Replace(Replace(Mid(str, 2), ":", "-"), "A", "")
    
    Debug.Print str 'строка результата: 1-3,5,7,9-11
End Sub
[/vba]
По шагам внутри процесса получаются примерно следующие трансформации:
[vba]
Код
1,2,3,5,7,9,10,11
A1,A2,A3,A5,A7,A9,A10,A11
A1:A3,A5,A7,A9:A11
1-3,5,7,9-11
[/vba]
Метод не то, чтобы самый краткий и быстрый, но, согласитесь, по-своему прикольный. Разумеется, со всеми естественными ограничениями Excel (типа миллион строк и т.п.).

[p.s.]Если нужна аналогичная функция рабочего листа (UDF), то оформляется на раз (добавлен пробел после запятой):[/p.s.]
[vba]
Код
Function ЦЕЛЫЕ_ДИАПАЗОНЫ(rngSrc As Range) As String
    Dim rng As Range, area As Range, str As String, arr, item
    arr = Split("A" & Replace(Join(Application.Transpose(rngSrc), ","), ",", ",A"), ",")
    Set rng = Range(arr(0))
    For Each item In arr
        Set rng = Union(rng, Range(item))
    Next
    For Each area In rng.Areas
        str = str & ", " & area.Address(0, 0)
    Next
    ЦЕЛЫЕ_ДИАПАЗОНЫ = Replace(Replace(Mid(str, 3), ":", "-"), "A", "")
End Function
[/vba]

Автор - Gustav
Дата добавления - 13.09.2023 в 21:56
and_evg Дата: Четверг, 14.09.2023, 06:41 | Сообщение № 9
Группа: Проверенные
Ранг: Обитатель
Сообщений: 460
Репутация: 77 ±
Замечаний: 0% ±

Excel 2007
Да уж... что то вчера полдня искал и все без результата... совсем разучился искать :'(
Но все равно всем СПАСИБО !!!


Сообщение отредактировал and_evg - Четверг, 14.09.2023, 06:42
 
Ответить
СообщениеДа уж... что то вчера полдня искал и все без результата... совсем разучился искать :'(
Но все равно всем СПАСИБО !!!

Автор - and_evg
Дата добавления - 14.09.2023 в 06:41
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!