Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Представить последовательность вида 1;2;3;4 в виде 1-4
 
#1
24.10.2021 10:12:53
Добрый день! Прошу помочь в группированию значений, сокращая тем длину строки.
 
 
 
#2
25.10.2021 13:31:31
Тема: "Представить последовательность вида 1;2;3;4 в виде 1-4"
=ПОРЯДОК(ССЫЛКА НА ЯЧЕЙКУ; РАЗДЕЛИТЕЛЬ)
Если разделитель пропущен, то по умолчанию ";"
Код
Public Function ПОРЯДОК(Ych As Range, Optional Razdel As String) As String
Dim st As String, Raz As String, y, Arr1, i As Integer, Nun As String, Pref As String
Raz = IIf(Razdel = "", ";", Razdel)
Set RE = CreateObject("VBScript.RegExp")
RE.Global = True
RE.Pattern = "\d+$"
Set dic = CreateObject("Scripting.Dictionary")
Arr1 = Split(Ych.Value, Raz)
For i = 0 To UBound(Arr1)
st = Trim(Arr1(i))
    If RE.Test(st) Then
        Num = RE.Execute(st).Item(RE.Execute(st).Count - 1).Value
        If Len(st) = Len(Trim(Num)) Then
            Pref = "XXXXXX"
        Else
            Pref = Left(Trim(st), Len(Trim(st)) - Len(Trim(Num)))
        End If
        If Not dic.exists(Trim(Pref)) Then Set dic(Trim(Pref)) = CreateObject("System.Collections.ArrayList")
        If Not dic(Trim(Pref)).Contains(CDbl(Trim(Num))) Then dic(Trim(Pref)).Add CDbl(Trim(Num))
    End If
Next
For Each y In dic
    dic(y).Sort
    Arr1 = dic(y).ToArray
    For i = 0 To UBound(Arr1)
        If i = 0 Then
            st = IIf(y = "XXXXXX", Arr1(i), y & Arr1(i))
        ElseIf i = UBound(Arr1) Then
            If Arr1(i) - 1 = Arr1(i - 1) Then
                st = st & "-" & IIf(y = "XXXXXX", Arr1(i), y & Arr1(i))
            ElseIf Arr1(i) - 1 <> Arr1(i - 1) Then
                st = st & Raz & " " & IIf(y = "XXXXXX", Arr1(i), y & Arr1(i))
            End If
        Else
            If Arr1(i) - 1 = Arr1(i - 1) And Arr1(i) + 1 <> Arr1(i + 1) Then
                st = st & "-" & IIf(y = "XXXXXX", Arr1(i), y & Arr1(i))
            ElseIf Arr1(i) - 1 <> Arr1(i - 1) Then
                st = st & Raz & " " & IIf(y = "XXXXXX", Arr1(i), y & Arr1(i))
            End If
        End If
    Next
    dic(y) = st
Next
ПОРЯДОК = Join(dic.items, Raz & " ")
End Function
Изменено: Msi2102 - 25.10.2021 15:07:21
 
 
 
#3
27.10.2021 01:28:27
Спасибо большое!  :)  
 
 
 
#4
22.02.2023 15:23:57
Msi2102,  Добрый день. У меня вопрос к автору кода. У меня в загруженном файле формула выдает ошибку "#ЗНАЧ!", какие настройки эксель или редактора надо обязательно включить, что бы код читался?  большое спасибо, что вы делитесь
Изменено: Софья Золкина - 22.02.2023 15:43:31
 
 
 
#5
22.02.2023 17:03:03
Цитата
Софья Золкина написал:
У меня в загруженном файле формула выдает ошибку "#ЗНАЧ!", какие настройки эксель или редактора надо обязательно включить, что бы код читался?
Не могу Вам сказать, скачал всё работает.

Вот ТУТ и ТУТ посмотрите ещё две подобные темы
Изменено: Msi2102 - 22.02.2023 17:09:41
 
 
 
#6
22.02.2023 21:24:49
Покопавшись на просторах интернета и форума. Я поняла, что у меня ошибка возникает из-за сочетания Windows 10 x64 и строки

"If Not dic.exists(Trim(Pref)) Then Set dic(Trim(Pref)) = CreateObject("System.Collections.ArrayList")"
они похоже не дружат и поэтому функция не работает. Очень жаль. Она бы мне очень пригодилась. В схожих темах есть схожие коды и они также отказываются работать
 
 
 
#7
22.02.2023 21:40:44
Цитата
Софья Золкина написал:
, что у меня ошибка возникает из-за сочетания Windows 10 x64 и строки
ну не знаю, когда я его писал у меня стоял Windows 10 x64, такой проблемы не было.
А у вас в скаченном файле не работает или вы его пытаетесь перенести в свой и он перестаёт работать?
 
 
 
#8
22.02.2023 22:05:42
Цитата
написал:
А у вас в скаченном файле не работает или вы его пытаетесь перенести в свой и он перестаёт работать?
В скаченном, не пойму почему
 
 
 
#9
23.02.2023 02:09:27
пробуйте этот
Код
Function UnionDigits$(s)
  Dim c&, d&, i&, m$, p&, t$
  s = Replace(s, " ", ""): i = 1
  For i = 1 To Len(s)
    If Mid(s, i, 1) Like "#" Then Exit For
  Next
  If i > 1 Then t = Left(s, i - 1)
  Do
    p = i
    For i = i + 1 To Len(s)
      If Not Mid(s, i, 1) Like "#" Then Exit For
    Next
    d = Val(Mid(s, p, i - p)): m = "*" & d & "?" & d + 1: c = 2
    Do While s Like m & "?" & d + c & "*"
      m = m & "?" & d + c: c = c + 1
    Loop
    If c > 2 Then
      t = t & d & "-" & d + c - 1: i = p + Len(m)
      If i < Len(s) Then t = t & ";"
    Else
      t = t & Mid(s, p, i - p + 1): i = i + 1
    End If
    If i >= Len(s) Then UnionDigits = t: Exit Do
  Loop
End Function
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#10
23.02.2023 03:23:18
мои данные, которые надо сделать с разделителем "-" выглядят примерно так:
C1;C10;C11;C13;C14;C15;C2;C4;C5;C6;C7;C8;C9
надо получить:
С1;C2;C4-C11;C13-C15
а данный код только числа считает и не сортирует
 
 
 
#11
23.02.2023 03:32:59
Цитата
написал:
данные, которые надо сделать с разделителем "-" выглядят примерно так
Надо файл прикладывать, а не писать: "примерно так". Когда же вы будете правила соблюдать?
 
 
 
#12
23.02.2023 08:09:25
Цитата
Софья Золкина написал:
мои данные, которые надо сделать с разделителем "-" выглядят примерно так:
Вот, оба моих файла работают. Разница между ними, в том, что в первой формуле разделителем автоматически является либо ";" либо "," , а во второй формуле если разделитель ";" то можно указывать, а если другой (к примеру запятая), то нужно указать
Изменено: Msi2102 - 23.02.2023 08:58:43
 
 
 
#13
23.02.2023 14:03:17
Благодарю за уделенное внимание, но к сожалею Вариант 1 пишет "Ошибка", вар 2 по прежнему "#ЗНАЧ!". Видимо у меня в настройках системы что то препятствует вычислению. Другие макросы и формулы без  подобных ссылок работают и вычисляются корректно. Попробовала на другом доступном мне компьютере, там то же самое.
Изменено: Софья Золкина - 23.02.2023 15:00:08
 
 
 
#14
23.02.2023 14:55:55
Софья Золкина, ещё вопрос, а Вы открываете файл в Excel или в гугловских таблицах?
 
 
 
#15
23.02.2023 14:58:59
Цитата
написал:
Вы открываете файл в Excel или в гугловских таблицах?
в Excel 2007 и на другом компе в Excel 2016
 
 
 
#16
25.02.2023 06:17:23
Наконец-то нашла решение. Необходимо было до установить компоненты и все заработало
 
 
 
#17
25.02.2023 18:02:18
Софья Золкина, Рад, что у Вас всё получилось
 
 
 
#18
10.06.2023 15:52:48
Msi2102, Здравствуйте, в вашей формуле рядом стоящие числа при группировке также идут через тире, например 1,2,4,5,6 будет выглядеть 1-2,4-6. Можно ли как-то изменить макрос, чтоб рядом стоящие числа шли через запятую? То есть так: 1,2,4-6.  
 
 
 
#19
10.06.2023 21:35:43
Vladimir Z., Реально лень разбираться, что я писал в феврале месяце, но думаю 1-2,4-6 запись будет более правильной, чем 1,2,4-6, так как она показывает, что если идут подряд даже два значения, то через дефис. Если не париться (как писал классик: "Дела давно минувших лет преданья старины глубокой"), то можно, конечно, ещё раз разбить на массив проверить на последовательность, заменить и собрать, хоть это не совсем правильно, но будем считать, что Вы меня заставили силой  :D
PS Можете ещё посмотреть темы ЭТУ, ЭТУ, ЭТУ и ЭТУ и ЭТУ
Изменено: Msi2102 - 13.06.2023 12:56:07
 
 
 
#20
11.06.2023 10:11:13
Msi2102, спасибо огромное! )
 
 
 
Страницы: 1
Наверх