Удаление одно и двухсложных слов макросом после закрытия ячейки после редактиров

[radius]

Здравствуйте. У меня вот такая задача. Я работаю в Калке, ввожу текст в ячейку. Можно ли, сделать так, чтобы после нажатия клавиши Enter запускался макрос и удалял из только что активной ячейки одно, двух и трёхсложные слова. Спасибо.

[bigor]

А вы можете сформулировать правило, по которому макрос будет определять такие слова?

[radius]

Все слова, состоящие из 1, 2 и 3 букв без исключений. В любом месте ячейки. В любом регистре. Латиницы не будет. Цифры игнорируются. Не знаю, какие еще можно придумать критерии.

[bigor]

наверное гласных букв, и то по недавней теме с переносами, там наверняка куча исключений.

[radius]

Любых букв (и гласных и согласных) в любом порядке. Например - "ккк" "хмм" "ора" и т.д. Без исключений.

[sokol92]

Если правильно понял условия задачи. Добавьте следующий модуль в библиотеку Standard документа (или приложения). Далее, правая кнопка по ярлыку листа, События листа и на событие "Содержимое изменено" назначьте макрос DelShortWords.

Код Выделить Развернуть

Option Explicit
' обработка события листа "Содержимое изменено"
Sub DelShortWords(oEvent)
With oEvent
   If .supportsService ("com.sun.star.sheet.SheetCell") Then ' изменена одна ячейка
     If .CellContentType=2 Then                              ' в ячейке текст
       .String=DelShortWordsStr(.String)   
     End If
   End If   
End With 

End Sub

' удаляет из строки s слова из 1-3 букв
Function DelShortWordsStr(ByVal s) As String
  Dim result As String, v, i As Long, bDel As Boolean
 
  For Each v In Split(s)
    If v<>"" Then
      If len(v)<=3 Then
        bDel=True
        For i=1 To len(v)
          If ucase(mid(v,i,1))=lcase(mid(v,i,1)) Then   ' символ не является буквой
            bDel=False
            Exit For
          End If 
        Next i
      Else
        bDel=False
      End If       
      If Not bDel Then
        result=IIf(result="", "", result & " ") & v
      End If 
    End If 
  Next v

  DelShortWordsStr=result
End Function

[radius]

Огромное спасибо, попробовал - работает!