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

Вход

Регистрация

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

 

= Мир MS Excel/Разделение ячейки через знак препинание - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Разделение ячейки через знак препинание (Формулы/Formulas)
Разделение ячейки через знак препинание
4step Дата: Пятница, 01.07.2022, 06:35 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 46
Репутация: 0 ±
Замечаний: 0% ±

Добрый день! Возможно ли разделить ячейку по значениям с дальнейшим выводом в соседнею ячейку через "; "?
К сообщению приложен файл: 1345031.xlsx(9.8 Kb)


Сообщение отредактировал Serge_007 - Вторник, 05.07.2022, 17:17
 
Ответить
СообщениеДобрый день! Возможно ли разделить ячейку по значениям с дальнейшим выводом в соседнею ячейку через "; "?

Автор - 4step
Дата добавления - 01.07.2022 в 06:35
msi2102 Дата: Пятница, 01.07.2022, 08:27 | Сообщение № 2
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 171
Репутация: 75 ±
Замечаний: 0% ±

Excel 2007
Объясните откуда в ДОЛЖНО БЫТЬ значений стало в два раза больше чем в ИМЕЕТСЯ?
 
Ответить
СообщениеОбъясните откуда в ДОЛЖНО БЫТЬ значений стало в два раза больше чем в ИМЕЕТСЯ?

Автор - msi2102
Дата добавления - 01.07.2022 в 08:27
scriptapplications Дата: Пятница, 01.07.2022, 09:49 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 34
Репутация: 7 ±
Замечаний: 0% ±

msi2102, видимо, знак "-" указывает на диапазон
"X090-X098" означает "X090; X091; X092; X093; X094; X095; X096; X097; X098"


Сообщение отредактировал scriptapplications - Пятница, 01.07.2022, 09:50
 
Ответить
Сообщениеmsi2102, видимо, знак "-" указывает на диапазон
"X090-X098" означает "X090; X091; X092; X093; X094; X095; X096; X097; X098"

Автор - scriptapplications
Дата добавления - 01.07.2022 в 09:49
bigor Дата: Пятница, 01.07.2022, 09:54 | Сообщение № 4
Группа: Проверенные
Ранг: Ветеран
Сообщений: 670
Репутация: 136 ±
Замечаний: 0% ±

нет
я понял, что нужно раскрыть диапазон заданный X090-X098 итд
 
Ответить
Сообщениея понял, что нужно раскрыть диапазон заданный X090-X098 итд

Автор - bigor
Дата добавления - 01.07.2022 в 09:54
Nic70y Дата: Пятница, 01.07.2022, 16:00 | Сообщение № 5
Группа: Друзья
Ранг: Экселист
Сообщений: 7646
Репутация: 1827 ±
Замечаний: 0% ±

Excel 2010
вдруг правильно
[vba]
Код
Sub u_623()
    Application.ScreenUpdating = False
    ssa = Cells(Rows.Count, "a").End(xlUp).Row
    If ssa = 1 Then ssa = 2
    For Each c In Range("a2:a" & ssa)
        aa = c.Value
        If c <> "" Then
            ab = Replace(Replace(aa, ",", ";"), " ", "") & ";"
            ac = Len(ab) - Len(Replace(ab, ";", ""))
            s = ""
            q = ""
            For i = 1 To ac
                ca = InStr(ab, ";")
                cb = Left(ab, ca - 1)
                cc = InStr(cb, "-")
                cb_ = --Mid(ab, ca - 3, 3)
                If cc > 0 Then
                    g_min = Mid(cb, cc - 3, 3)
                    g_max = Right(cb, 3)
                    g_tex = Left(cb, cc - 4)
                    g_klv = g_max - g_min + 1
                    For j = 1 To g_klv
                        x = g_tex & Right("00" & g_min + j - 1, 3)
                        t = ","""
                        If s = "" Then t = """"
                        s = s & t & x & """" 'ar1
                        u = ","
                        If q = "" Then u = ""
                        q = q & u & g_min + j - 1 'ar2
                    Next
                Else
                    t = ","""
                    If s = "" Then t = """"
                    s = s & t & cb & """" 'ar1
                    u = ","
                    If q = "" Then u = ""
                    q = q & u & cb_ 'ar2
                End If
                ab = Mid(ab, ca + 1, Len(ab))
            Next
            la = Len(q) - Len(Replace(q, ",", "")) + 1
            k = ""
            For l = 1 To la
                lb = Evaluate("=SMALL({" & q & "}," & l & ")")
                lc = Evaluate("=MATCH(" & lb & ",{" & q & "},0)")
                ld = Evaluate("=INDEX({" & s & "}," & lc & ")")
                y = "; "
                If k = "" Then y = ""
                k = k & y & ld
            Next
            c.Offset(0, 1) = k
        End If
    Next
    Application.ScreenUpdating = True
End Sub
[/vba]
К сообщению приложен файл: 20.xlsm(21.9 Kb)


ЮMoney 41001841029809
 
Ответить
Сообщениевдруг правильно
[vba]
Код
Sub u_623()
    Application.ScreenUpdating = False
    ssa = Cells(Rows.Count, "a").End(xlUp).Row
    If ssa = 1 Then ssa = 2
    For Each c In Range("a2:a" & ssa)
        aa = c.Value
        If c <> "" Then
            ab = Replace(Replace(aa, ",", ";"), " ", "") & ";"
            ac = Len(ab) - Len(Replace(ab, ";", ""))
            s = ""
            q = ""
            For i = 1 To ac
                ca = InStr(ab, ";")
                cb = Left(ab, ca - 1)
                cc = InStr(cb, "-")
                cb_ = --Mid(ab, ca - 3, 3)
                If cc > 0 Then
                    g_min = Mid(cb, cc - 3, 3)
                    g_max = Right(cb, 3)
                    g_tex = Left(cb, cc - 4)
                    g_klv = g_max - g_min + 1
                    For j = 1 To g_klv
                        x = g_tex & Right("00" & g_min + j - 1, 3)
                        t = ","""
                        If s = "" Then t = """"
                        s = s & t & x & """" 'ar1
                        u = ","
                        If q = "" Then u = ""
                        q = q & u & g_min + j - 1 'ar2
                    Next
                Else
                    t = ","""
                    If s = "" Then t = """"
                    s = s & t & cb & """" 'ar1
                    u = ","
                    If q = "" Then u = ""
                    q = q & u & cb_ 'ar2
                End If
                ab = Mid(ab, ca + 1, Len(ab))
            Next
            la = Len(q) - Len(Replace(q, ",", "")) + 1
            k = ""
            For l = 1 To la
                lb = Evaluate("=SMALL({" & q & "}," & l & ")")
                lc = Evaluate("=MATCH(" & lb & ",{" & q & "},0)")
                ld = Evaluate("=INDEX({" & s & "}," & lc & ")")
                y = "; "
                If k = "" Then y = ""
                k = k & y & ld
            Next
            c.Offset(0, 1) = k
        End If
    Next
    Application.ScreenUpdating = True
End Sub
[/vba]

Автор - Nic70y
Дата добавления - 01.07.2022 в 16:00
msi2102 Дата: Пятница, 01.07.2022, 16:41 | Сообщение № 6
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 171
Репутация: 75 ±
Замечаний: 0% ±

Excel 2007
Можно ещё пользовательской функцией (UDF)
[vba]
Код
Public Function Разбивка(ByRef rng As Range)
Dim n, m, s As String, x As String, y As Integer, y1 As Integer
On Error GoTo ErrHand
Set re = CreateObject("VBScript.RegExp")
Set dic = CreateObject("Scripting.Dictionary")
re.Global = True: re.Pattern = "\d+"
s = Replace(Replace(rng.Value, ",", ";"), " ", "")
arr1 = Split(s, ";")
For Each n In arr1
    arr2 = Split(n, "-")
    x = re.Replace(arr2(0), "")
    If Not dic.Exists(x) Then Set dic(x) = CreateObject("System.Collections.ArrayList")
    y = CInt(Replace(arr2(0), x, ""))
    If UBound(arr2) > 0 Then y1 = CInt(Replace(arr2(1), x, "")) Else y1 = y
    For m = y To y1
        If Not dic(x).contains(m) Then dic(x).Add m
    Next m
Next n
s = ""
For Each n In dic
    dic(n).Sort
    For Each m In dic(n)
        s = s & "; " & n & Format(m, "0##") 'dic(n).Item
    Next
Next
Разбивка = Mid(s, 3)
Exit Function
ErrHand:
Разбивка = "Ошибка"
End Function
[/vba]
К сообщению приложен файл: 1345031.xlsm(19.4 Kb)


Сообщение отредактировал msi2102 - Пятница, 01.07.2022, 16:48
 
Ответить
СообщениеМожно ещё пользовательской функцией (UDF)
[vba]
Код
Public Function Разбивка(ByRef rng As Range)
Dim n, m, s As String, x As String, y As Integer, y1 As Integer
On Error GoTo ErrHand
Set re = CreateObject("VBScript.RegExp")
Set dic = CreateObject("Scripting.Dictionary")
re.Global = True: re.Pattern = "\d+"
s = Replace(Replace(rng.Value, ",", ";"), " ", "")
arr1 = Split(s, ";")
For Each n In arr1
    arr2 = Split(n, "-")
    x = re.Replace(arr2(0), "")
    If Not dic.Exists(x) Then Set dic(x) = CreateObject("System.Collections.ArrayList")
    y = CInt(Replace(arr2(0), x, ""))
    If UBound(arr2) > 0 Then y1 = CInt(Replace(arr2(1), x, "")) Else y1 = y
    For m = y To y1
        If Not dic(x).contains(m) Then dic(x).Add m
    Next m
Next n
s = ""
For Each n In dic
    dic(n).Sort
    For Each m In dic(n)
        s = s & "; " & n & Format(m, "0##") 'dic(n).Item
    Next
Next
Разбивка = Mid(s, 3)
Exit Function
ErrHand:
Разбивка = "Ошибка"
End Function
[/vba]

Автор - msi2102
Дата добавления - 01.07.2022 в 16:41
4step Дата: Понедельник, 04.07.2022, 00:57 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 46
Репутация: 0 ±
Замечаний: 0% ±

правильно
Все работает! Благодарю! :)
 
Ответить
Сообщение
правильно
Все работает! Благодарю! :)

Автор - 4step
Дата добавления - 04.07.2022 в 00:57
4step Дата: Вторник, 05.07.2022, 15:23 | Сообщение № 8
Группа: Пользователи
Ранг: Новичок
Сообщений: 46
Репутация: 0 ±
Замечаний: 0% ±

Nic70y, а возможно ли переделать выше указанные варианты, например имеются значения: PE1, PE11, PE112; SF2; QF1.2 и так далее...


Сообщение отредактировал 4step - Вторник, 05.07.2022, 15:24
 
Ответить
СообщениеNic70y, а возможно ли переделать выше указанные варианты, например имеются значения: PE1, PE11, PE112; SF2; QF1.2 и так далее...

Автор - 4step
Дата добавления - 05.07.2022 в 15:23
Nic70y Дата: Вторник, 05.07.2022, 17:10 | Сообщение № 9
Группа: Друзья
Ранг: Экселист
Сообщений: 7646
Репутация: 1827 ±
Замечаний: 0% ±

Excel 2010
4step, приложите файл-пример


ЮMoney 41001841029809
 
Ответить
Сообщение4step, приложите файл-пример

Автор - Nic70y
Дата добавления - 05.07.2022 в 17:10
4step Дата: Среда, 06.07.2022, 16:21 | Сообщение № 10
Группа: Пользователи
Ранг: Новичок
Сообщений: 46
Репутация: 0 ±
Замечаний: 0% ±

Nic70y, прилагаю файл.
К сообщению приложен файл: 4066541.xlsm(23.6 Kb)
 
Ответить
СообщениеNic70y, прилагаю файл.

Автор - 4step
Дата добавления - 06.07.2022 в 16:21
Nic70y Дата: Четверг, 07.07.2022, 07:40 | Сообщение № 11
Группа: Друзья
Ранг: Экселист
Сообщений: 7646
Репутация: 1827 ±
Замечаний: 0% ±

Excel 2010
4step, не понял из вашего файла ни чего.
переложил удф в стандартный модуль
К сообщению приложен файл: 2693405.xlsm(24.1 Kb)


ЮMoney 41001841029809
 
Ответить
Сообщение4step, не понял из вашего файла ни чего.
переложил удф в стандартный модуль

Автор - Nic70y
Дата добавления - 07.07.2022 в 07:40
4step Дата: Четверг, 07.07.2022, 12:14 | Сообщение № 12
Группа: Пользователи
Ранг: Новичок
Сообщений: 46
Репутация: 0 ±
Замечаний: 0% ±

Nic70y, Полная информация с пояснением здесь приложил (см. № 7).


Сообщение отредактировал 4step - Четверг, 07.07.2022, 12:15
 
Ответить
СообщениеNic70y, Полная информация с пояснением здесь приложил (см. № 7).

Автор - 4step
Дата добавления - 07.07.2022 в 12:14
4step Дата: Пятница, 08.07.2022, 13:24 | Сообщение № 13
Группа: Пользователи
Ранг: Новичок
Сообщений: 46
Репутация: 0 ±
Замечаний: 0% ±

msi2102, можно ли ещё попросить доработать функцию как указанно в примере?
К сообщению приложен файл: 2106381.xlsx(10.5 Kb)
 
Ответить
Сообщениеmsi2102, можно ли ещё попросить доработать функцию как указанно в примере?

Автор - 4step
Дата добавления - 08.07.2022 в 13:24
4step Дата: Понедельник, 11.07.2022, 12:46 | Сообщение № 14
Группа: Пользователи
Ранг: Новичок
Сообщений: 46
Репутация: 0 ±
Замечаний: 0% ±

Пример обозначения: 3KM1.3, где
● 3 - это часть изделия, состоящая например из панели или ячейки или шкафа - номер оболочки;
● KM - тип оборудования (контактор);
● 1 - порядковый номер оборудования;
● 3 - порядковый номер составляющего оборудования/аксессуар (например катушка или дополнительный контакт вх. в состав контактора);
● точка - разделитель.
Т. е. 3KM1.3 - это составляющая часть контактора KM, которая в ходит в состав панели № 3.

Элемент может быть иметь форму: полную - 3KM1.3; расширенную - KM1.1; стандартную - KM1; единичную - KM.


Сообщение отредактировал 4step - Понедельник, 11.07.2022, 15:03
 
Ответить
СообщениеПример обозначения: 3KM1.3, где
● 3 - это часть изделия, состоящая например из панели или ячейки или шкафа - номер оболочки;
● KM - тип оборудования (контактор);
● 1 - порядковый номер оборудования;
● 3 - порядковый номер составляющего оборудования/аксессуар (например катушка или дополнительный контакт вх. в состав контактора);
● точка - разделитель.
Т. е. 3KM1.3 - это составляющая часть контактора KM, которая в ходит в состав панели № 3.

Элемент может быть иметь форму: полную - 3KM1.3; расширенную - KM1.1; стандартную - KM1; единичную - KM.

Автор - 4step
Дата добавления - 11.07.2022 в 12:46
msi2102 Дата: Понедельник, 11.07.2022, 19:36 | Сообщение № 15
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 171
Репутация: 75 ±
Замечаний: 0% ±

Excel 2007
Попробуйте так:
[vba]
Код
Public Function Разбивка(ByRef rng As Range)
Dim n, m, s As String, x As String, y As Integer, y1 As Integer
On Error GoTo ErrHand
Set re = CreateObject("VBScript.RegExp")
Set dic = CreateObject("System.Collections.SortedList")
re.Global = True: re.Pattern = "(\d+)$"
s = Replace(Replace(rng.Value, ",", ";"), " ", "")
arr1 = Split(s, ";")
For Each n In arr1
If n <> "" Then
    If re.Test(n) Then
        arr2 = Split(n, "-")
        x = re.Replace(arr2(0), "")
        If Not dic.Contains(x) Then Set dic(x) = CreateObject("Scripting.Dictionary")
        y = CInt(Replace(arr2(0), x, ""))
        i = Len(Replace(arr2(0), x, ""))
        If UBound(arr2) > 0 Then y1 = CInt(Replace(arr2(1), x, "")) Else y1 = y
        For m = y To y1
            If Not dic(x).Exists(CStr(m)) Then dic(x).Add CStr(m), i
        Next m
    Else
        i = Len(n)
        If Not dic.Contains(n) Then Set dic(n) = CreateObject("Scripting.Dictionary")
        If Not dic(n).Exists(CStr(n)) Then dic(n).Add CStr(n), -1
    End If
End If
Next n
s = ""
For n = 0 To dic.Count - 1
    For Each m In dic(dic.GetKey(n))
        If dic(dic.GetKey(n)).Item(m) > 0 Then
            If CInt(dic(dic.GetKey(n)).Item(m)) - Len(m) > 0 Then
                s = s & "; " & dic.GetKey(n) & String(dic(dic.GetKey(n)).Item(m) - Len(m), "0") & m
            Else
                s = s & "; " & dic.GetKey(n) & m
            End If
        Else
            s = s & "; " & m
        End If
    Next
Next
Разбивка = Mid(s, 3)
Exit Function
ErrHand:
Разбивка = "Ошибка"
End Function
[/vba]
Разбивает по последнему числу, либо до точки, либо до любого символа. Такие значения как 33А-А36, или QF1.1-QF3.1 выдадут ошибку
К сообщению приложен файл: 1345031-2-.xlsm(19.2 Kb)
 
Ответить
СообщениеПопробуйте так:
[vba]
Код
Public Function Разбивка(ByRef rng As Range)
Dim n, m, s As String, x As String, y As Integer, y1 As Integer
On Error GoTo ErrHand
Set re = CreateObject("VBScript.RegExp")
Set dic = CreateObject("System.Collections.SortedList")
re.Global = True: re.Pattern = "(\d+)$"
s = Replace(Replace(rng.Value, ",", ";"), " ", "")
arr1 = Split(s, ";")
For Each n In arr1
If n <> "" Then
    If re.Test(n) Then
        arr2 = Split(n, "-")
        x = re.Replace(arr2(0), "")
        If Not dic.Contains(x) Then Set dic(x) = CreateObject("Scripting.Dictionary")
        y = CInt(Replace(arr2(0), x, ""))
        i = Len(Replace(arr2(0), x, ""))
        If UBound(arr2) > 0 Then y1 = CInt(Replace(arr2(1), x, "")) Else y1 = y
        For m = y To y1
            If Not dic(x).Exists(CStr(m)) Then dic(x).Add CStr(m), i
        Next m
    Else
        i = Len(n)
        If Not dic.Contains(n) Then Set dic(n) = CreateObject("Scripting.Dictionary")
        If Not dic(n).Exists(CStr(n)) Then dic(n).Add CStr(n), -1
    End If
End If
Next n
s = ""
For n = 0 To dic.Count - 1
    For Each m In dic(dic.GetKey(n))
        If dic(dic.GetKey(n)).Item(m) > 0 Then
            If CInt(dic(dic.GetKey(n)).Item(m)) - Len(m) > 0 Then
                s = s & "; " & dic.GetKey(n) & String(dic(dic.GetKey(n)).Item(m) - Len(m), "0") & m
            Else
                s = s & "; " & dic.GetKey(n) & m
            End If
        Else
            s = s & "; " & m
        End If
    Next
Next
Разбивка = Mid(s, 3)
Exit Function
ErrHand:
Разбивка = "Ошибка"
End Function
[/vba]
Разбивает по последнему числу, либо до точки, либо до любого символа. Такие значения как 33А-А36, или QF1.1-QF3.1 выдадут ошибку

Автор - msi2102
Дата добавления - 11.07.2022 в 19:36
4step Дата: Вторник, 12.07.2022, 13:42 | Сообщение № 16
Группа: Пользователи
Ранг: Новичок
Сообщений: 46
Репутация: 0 ±
Замечаний: 0% ±

msi2102, Очень благодарен за проделанный ваш труд! Все работает как надо. Спасибо! =)
 
Ответить
Сообщениеmsi2102, Очень благодарен за проделанный ваш труд! Все работает как надо. Спасибо! =)

Автор - 4step
Дата добавления - 12.07.2022 в 13:42
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Разделение ячейки через знак препинание (Формулы/Formulas)
  • Страница 1 из 1
  • 1
Поиск:

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