РАЗДЕЛЕНИЕ склеенных слов точкой и пробелом

[admin]

• При запуске появляется окно запроса:
  • Ввод буквы столбца, в котором нужно разделять слова (например, A, B, C).

• Макрос:
  • Регулярное выражение ищет букву или цифру перед заглавной буквой, и вставляет точку с пробелом;
  • Удаляет ошибочные вставки перед !, ?, ".

1. Открыть редактор макросов — сочетанием Alt + F11
2. Выделить ваш проект левой кнопкой мыши (VBAProject (Ваш проект.xIsx), нажать на нем правой и выбрать: Вставить - Модуль (Insert > Module)
3. В пустом окне нового модуля пишем код:

Sub FixConcatenatedSentences()
    Dim ws As Worksheet
    Dim colLetter As String
    Dim colNumber As Long
    Dim lastRow As Long
    Dim dataArr As Variant
    Dim i As Long, originalLine As String, fixedLine As String

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    Set ws = ActiveSheet
    colLetter = InputBox("Enter column letter to process (e.g., C):", "Column Selection")
    If Trim(colLetter) = "" Then GoTo Cleanup

    On Error Resume Next
    colNumber = Range(colLetter & "1").Column
    On Error GoTo 0
    If colNumber = 0 Then MsgBox "Invalid column!", vbCritical: GoTo Cleanup

    lastRow = ws.Cells(ws.Rows.Count, colNumber).End(xlUp).Row
    If lastRow < 2 Then GoTo Cleanup

    dataArr = ws.Range(ws.Cells(2, colNumber), ws.Cells(lastRow, colNumber)).Value

    For i = 1 To UBound(dataArr, 1)
        originalLine = dataArr(i, 1)
        If Trim(originalLine) <> "" Then
            fixedLine = FixSkleikaAdvanced(originalLine)
            If fixedLine <> originalLine Then
                dataArr(i, 1) = fixedLine
            End If
        End If
    Next i

    ws.Range(ws.Cells(2, colNumber), ws.Cells(lastRow, colNumber)).Value = dataArr
    MsgBox "Concatenated phrases and sentence merges fixed.", vbInformation

Cleanup:
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End Sub

Function FixSkleikaAdvanced(ByVal line As String) As String
    Dim re As Object
    Set re = CreateObject("VBScript.RegExp")
    re.Global = True
    re.IgnoreCase = False

    ' Правило: строчная буква или цифра перед заглавной буквой без пробела -> вставляем ". "
    ' Пример: "напряженностиИзбавляет" -> "напряженности. Избавляет"
    re.Pattern = "([а-яa-z0-9])([А-ЯA-Z])"
    line = re.Replace(line, "$1. $2")

    ' Удалить лишние случаи ". !" ". ?" ". ""
    re.Pattern = "\. ([!""?])"
    line = re.Replace(line, " $1")

    FixSkleikaAdvanced = line
End Function

4. Открыть выполнение макросов — сочетанием Alt + F8
5. Выбираем макрос по названию в окне
6. Жмем "Выполнить" и смотрим результат