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

Вход

Регистрация

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

 

= Мир MS Excel/Разделение текста на предложения из одной колонки в разные - Страница 2 - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 2 из 2
  • «
  • 1
  • 2
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK  
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Разделение текста на предложения из одной колонки в разные (Формулы/Formulas)
Разделение текста на предложения из одной колонки в разные
SLAVICK Дата: Пятница, 05.01.2018, 14:15 | Сообщение № 21
Группа: Модераторы
Ранг: Старожил
Сообщений: 2183
Репутация: 735 ±
Замечаний: 0% ±

2007,2010,2013,2016
Например "пробел-точка-г" - " .г" г. - это город.

Как вариант можно вшить в функцию еще работу с таблицей исключений из 2-х колонок
[vba]
Код
Function Split_by_sentence(ByVal StringInp As String, Optional ByVal Patt As String = "([\.|\?|\!|\n]+(\s+)?[A-ZА-Я])", Optional ByVal Tabl)
    Dim i&, arr() As String
    If TypeName(Tabl) = "Range" Then Tabl = Tabl.Value
    If TypeName(Tabl) = "Error" Then Tabl = Application.Evaluate("={"" т.е."","" тЇeЇ"";"" г."","" гЇ"";"" т.д."","" тЇдЇ""}")
    For t = LBound(Tabl) To UBound(Tabl): StringInp = Replace(StringInp, Tabl(t, 1), Tabl(t, 2)): Next
    With CreateObject("Vbscript.regexp")
        .Pattern = Patt
        .Global = True
        If Not .test(StringInp) Then
            ReDim arr(0)
            arr(0) = StringInp
        Else
            Set Matches = .Execute(StringInp)
            ReDim arr(Matches.Count)
             For i = 0 To Matches.Count - 1
                    If i = 0 Then
                        arr(i) = Left(StringInp, Matches(i).FirstIndex + Len(Matches(i).submatches(0)) - 1)
                    Else
                        arr(i) = Mid(StringInp, Matches(i - 1).FirstIndex + Matches(i - 1).Length - 1, Matches(i).FirstIndex - Matches(i - 1).FirstIndex - Matches(i - 1).Length + Matches(i).Length)
                    End If
                    For t = LBound(Tabl) To UBound(Tabl): arr(i) = Replace(arr(i), Tabl(t, 2), Tabl(t, 1)): Next
                    arr(i) = Trim(arr(i))
            Next
            arr(i) = Mid(StringInp, Matches(i - 1).FirstIndex + Matches(i - 1).Length - 1, 999)
            For t = LBound(Tabl) To UBound(Tabl): arr(i) = Replace(arr(i), Tabl(t, 2), Tabl(t, 1)): Next
            arr(i) = Trim(arr(i))
        End If
    End With
    
    If Application.Caller.Cells.Count > UBound(arr) + 1 Then ReDim Preserve arr(Application.Caller.Cells.Count)
    Split_by_sentence = arr
End Function
[/vba]

Мама вышла, т.е. мама ушла

у меня - нормально
К сообщению приложен файл: 6970196-1-1-.xlsm(22.6 Kb)


Иногда все проще чем кажется с первого взгляда.
 
Ответить
Сообщение
Например "пробел-точка-г" - " .г" г. - это город.

Как вариант можно вшить в функцию еще работу с таблицей исключений из 2-х колонок
[vba]
Код
Function Split_by_sentence(ByVal StringInp As String, Optional ByVal Patt As String = "([\.|\?|\!|\n]+(\s+)?[A-ZА-Я])", Optional ByVal Tabl)
    Dim i&, arr() As String
    If TypeName(Tabl) = "Range" Then Tabl = Tabl.Value
    If TypeName(Tabl) = "Error" Then Tabl = Application.Evaluate("={"" т.е."","" тЇeЇ"";"" г."","" гЇ"";"" т.д."","" тЇдЇ""}")
    For t = LBound(Tabl) To UBound(Tabl): StringInp = Replace(StringInp, Tabl(t, 1), Tabl(t, 2)): Next
    With CreateObject("Vbscript.regexp")
        .Pattern = Patt
        .Global = True
        If Not .test(StringInp) Then
            ReDim arr(0)
            arr(0) = StringInp
        Else
            Set Matches = .Execute(StringInp)
            ReDim arr(Matches.Count)
             For i = 0 To Matches.Count - 1
                    If i = 0 Then
                        arr(i) = Left(StringInp, Matches(i).FirstIndex + Len(Matches(i).submatches(0)) - 1)
                    Else
                        arr(i) = Mid(StringInp, Matches(i - 1).FirstIndex + Matches(i - 1).Length - 1, Matches(i).FirstIndex - Matches(i - 1).FirstIndex - Matches(i - 1).Length + Matches(i).Length)
                    End If
                    For t = LBound(Tabl) To UBound(Tabl): arr(i) = Replace(arr(i), Tabl(t, 2), Tabl(t, 1)): Next
                    arr(i) = Trim(arr(i))
            Next
            arr(i) = Mid(StringInp, Matches(i - 1).FirstIndex + Matches(i - 1).Length - 1, 999)
            For t = LBound(Tabl) To UBound(Tabl): arr(i) = Replace(arr(i), Tabl(t, 2), Tabl(t, 1)): Next
            arr(i) = Trim(arr(i))
        End If
    End With
    
    If Application.Caller.Cells.Count > UBound(arr) + 1 Then ReDim Preserve arr(Application.Caller.Cells.Count)
    Split_by_sentence = arr
End Function
[/vba]

Мама вышла, т.е. мама ушла

у меня - нормально

Автор - SLAVICK
Дата добавления - 05.01.2018 в 14:15
Gustav Дата: Пятница, 05.01.2018, 16:12 | Сообщение № 22
Группа: Друзья
Ранг: Старожил
Сообщений: 1559
Репутация: 605 ±
Замечаний: 0% ±

начинал с Excel 4.0...
как изменить количество колонок, на которые делятся предложения? Сейчас на 3 колонки делятся, в остальных написано "Н/Д"

Тю! А у меня что-то сложилось устойчивое впечатление, что надо именно по 3-м разбить: первое предложение, второе и остальной текст. "А оно вона чо, Михалыч!" (с) Ну и ладно, так ещё и проще получается.



Мой tip box - яд 41001663842605
 
Ответить
Сообщение
как изменить количество колонок, на которые делятся предложения? Сейчас на 3 колонки делятся, в остальных написано "Н/Д"

Тю! А у меня что-то сложилось устойчивое впечатление, что надо именно по 3-м разбить: первое предложение, второе и остальной текст. "А оно вона чо, Михалыч!" (с) Ну и ладно, так ещё и проще получается.


Автор - Gustav
Дата добавления - 05.01.2018 в 16:12
atatat111 Дата: Пятница, 05.01.2018, 16:27 | Сообщение № 23
Группа: Пользователи
Ранг: Прохожий
Сообщений: 8
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
SLAVICK, Благодарю! Отлично разделяет предложения.

Gustav, А я сначала и не заметил, смотрю три предложения, думаю ну ладно три, а потом посчитал что их 5.
Тоже пытался изменить предпоследнюю строку выражения, но не получалось. Благодарю, что изменили выражения.
 
Ответить
СообщениеSLAVICK, Благодарю! Отлично разделяет предложения.

Gustav, А я сначала и не заметил, смотрю три предложения, думаю ну ладно три, а потом посчитал что их 5.
Тоже пытался изменить предпоследнюю строку выражения, но не получалось. Благодарю, что изменили выражения.

Автор - atatat111
Дата добавления - 05.01.2018 в 16:27
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Разделение текста на предложения из одной колонки в разные (Формулы/Formulas)
  • Страница 2 из 2
  • «
  • 1
  • 2
Поиск:

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