1 Тема от Pilat

  • Pilat
  • рядовой
  • Неактивен
  • Зарегистрирован: 18.11.2013
  • Сообщений: 2

Тема: Макрос быстрого поиска и замены но (не обрабатывает двойные слова)

sad  Работает быстро , но к сожалению ( не обрабатывает двойные слова Key:="Snup Dog" а тем более такие  Key:="The problem with a few words unnecessarily" , как это можно реализовать )

Sub Trans()
Dim C As New Collection
Dim W As Range, R As Range
Dim S As String, S2 As String

    C.Add Item:="Кот", Key:="Cat"
    C.Add Item:="Снуп дог", Key:="Snup Dog"
    C.Add Item:="Пять", Key:="Five"
    C.Add Item:="Проблема с несколькими словами т.к key ", Key:="The problem with a few words unnecessarily"
'(Как можно исправить )
    C.Add Item:="and", Key:=" "
    
For Each W In ActiveDocument.Range.Words
        Set R = W.Duplicate
        R.MoveEndWhile _
            CSet:=Chr$(32) & Chr$(160), _
            Count:=wdBackward
        If R.Start >= R.End Then GoTo NEXTW
           S = "": S = LCase$(R.Text)
               On Error Resume Next
        S2 = "": S2 = C.Item(S)
        If Err.Number <> 0 Then GoTo NEXTW
             R.Text = S2
NEXTW:
    Next W
    
End Sub

2 Ответ от shanemac51

  • shanemac51
  • генерал-полковник
  • Неактивен
  • Зарегистрирован: 05.03.2012
  • Сообщений: 467
  • Поблагодарили: 119
  • За сообщение: 1

Re: Макрос быстрого поиска и замены но (не обрабатывает двойные слова)

подобный перебор слов --не для вас
он вам не подходит
----
вам надо знать следующие слова, а в коллекции известно только текущее слово
вы встретили слово Snup , следующее disk
--но не знаете какие сочетания есть в словаре перевода
Snup Dog
Snup cat
Snup mouse

если эти сочетания --надо перевести
иначе перевести  Snup и оставить disk

и плясать надо от словаря в обратной сортировке по количеству слов