1

Тема: Нужна помощь

Допустим есть текст

"Thirty  Two Hundred and Thirty One Thousand Two Hundred and Twelve US Dollars

Five Million and One Thousand One Hundred and Eleven US Dollars

One Hundred and Eleven US Dollars
"
Макрос перевода с ENG to Rus :
1) Что бы работало быстро
2) Через массив
3) Желательно без Find and Replace

Help товарищи  roll

2

Re: Нужна помощь

Сделал (Но к сожалению через Find  and Replace )

Переводит и отваливается  (Как в том анекдоте "Типа из последних сил "  smile )

Sub transrus()
Dim i As Integer
Dim sLat As Variant
Dim sRus As Variant
Dim rDoc As Range
Set rDoc = ActiveDocument.Range

sLat = Array("One Billion", "Two Billion", "Three Billion", "Four Billion", "Five Billion", "Six Billion", "Seven Billion", "Eight Billion", "Nine Billion", _
"Ten Billion", "Eleven Billion", "Twelve Billion", "Thirteen Billion", "Fourteen Billion", "Fifteen Billion", "Sixteen Billion", "Seventeen Billion", "Eighteen Billion", _
"Nineteen Billion", "Twenty Billion", "Thirty Billion", "Forty Billion", "Fifty Billion", "Sixty Billion", "Seventy Billion", "Eighty Billion", "Ninety Billion", _
"One Million", "Two Million", "Three Million", "Four Million", "Five Million", "Six Million", "Seven Million", "Eight Million", "Nine Million", _
"Ten Million", "Eleven Million", "Twelve Million", "Thirteen Million", "Fourteen Million", "Fifteen Million", "Sixteen Million", "Seventeen Million", "Eighteen Million", _
"Nineteen Million", "Twenty Million", "Thirty Million", "Forty Million", "Fifty Million", "Sixty Million", "Seventy Million", "Eighty Million", "Ninety Million", _
"One Hundred Million", "Two Hundred Million", "Three Hundred Million", "Four Hundred Million", "Five Hundred Million", "Six Hundred Million", "Seven Hundred Million", "Eight Hundred Million", "Nine Hundred Million", _
"One Thousand", "Two Thousand", "Three Thousand", "Four Thousand", "Five Thousand", "Six Thousand", "Seven Thousand", "Eight Thousand", "Nine Thousand", _
"Ten Thousand", "Eleven Thousand", "Twelve Thousand", "Thirteen Thousand", "Fourteen Thousand", "Fifteen Thousand", "Sixteen Thousand", "Seventeen Thousand", "Eighteen Thousand", _
"Nineteen Thousand", "Twenty Thousand", "Thirty Thousand", "Forty Thousand", "Fifty Thousand", "Sixty Thousand", "Seventy Thousand", "Eighty Thousand", "Ninety Thousand", _
"Thousand", "One Hundred", "Two Hundred", "Three Hundred", "Four Hundred", "Five Hundred", "Six Hundred", "Seven Hundred", "Eight Hundred", _
"Nine Hundred", "Zero", "One", "Two", "Four", "Five", "Six", "Seven", "Eight", _
"Nine", "Ten", "Eleven", "Twelve", "Thirteen", "Fourteen", "Fifteen", "Sixteen", "Seventeen", _
"Eighteen", "Nineteen", "Twenty", "Thirty", "Forty", "Fifty", "Sixty", "Seventy", "Eighty", _
"Ninety", "and", "US Dollars", "Euro", "Russia Ruble", "January", "February", "March", "April", _
"May", "June", "July", "August", "September", "October", "November", "December")
sRus = Array("îäèí ìèëëèàðä", "äâà ìèëëèàðäà", "òðè ìèëëèàðäà", "÷åòûðå ìèëëèàðäà", "ïÿòü ìèëëèàðäîâ", "øåñòü ìèëëèàðäîâ", "ñåìü ìèëëèàðäîâ", "âîñåìü ìèëëèàðäîâ", "äåâÿòü ìèëëèàðäîâ", "äåñÿòü ìèëëèàðäîâ", _
"îäèííàäöàòü ìèëëèàðäîâ", "äâåíàäöàòü ìèëëèàðäîâ", "òðèíàäöàòü ìèëëèàðäîâ", "÷åòûðíàäöàòü ìèëëèàðäîâ", "ïÿòíàäöàòü ìèëëèàðäîâ", "øåñòíàäöàòü ìèëëèàðäîâ", "ñåìíàäöàòü ìèëëèàðäîâ", "âîñåìíàäöàòü ìèëëèàðäîâ", "äåâÿòíàäöàòü ìèëëèàðäîâ", _
"äâàäöàòü ìèëëèàðäîâ", "òðèäöàòü ìèëëèàðäîâ", "ñîðîê ìèëëèàðäîâ", "ïÿòüäåñÿò ìèëëèàðäîâ", "øåñòüäåñÿò ìèëëèàðäîâ", "ñåìüäåñÿò ìèëëèàðäîâ", "âîñåìüäåñÿò ìèëëèàðäîâ", "äåâÿíîñòî ìèëëèàðäîâ", "îäèí ìèëëèîí", _
"äâà ìèëëèîíà", "òðè ìèëëèîíà", "÷åòûðå ìèëëèîíà", "ïÿòü ìèëëèîíîâ", "øåñòü ìèëëèîíîâ", "ñåìü ìèëëèîíîâ", "âîñåìü ìèëëèîíîâ", "äåâÿòü ìèëëèîíîâ", "äåñÿòü ìèëëèîíîâ", _
"îäèííàäöàòü ìèëëèîíîâ", "äâåíàäöàòü ìèëëèîíîâ", "òðèíàäöàòü ìèëëèîíîâ", "÷åòûðíàäöàòü ìèëëèîíîâ", "ïÿòíàäöàòü ìèëëèîíîâ", "øåñòíàäöàòü ìèëëèîíîâ", "ñåìíàäöàòü ìèëëèîíîâ", "âîñåìíàäöàòü ìèëëèîíîâ", "äåâÿòíàäöàòü ìèëëèîíîâ", _
"äâàäöàòü ìèëëèîíîâ", "òðèäöàòü ìèëëèîíîâ", "ñîðîê ìèëëèîíîâ", "ïÿòüäåñÿò ìèëëèîíîâ", "øåñòüäåñÿò ìèëëèîíîâ", "ñåìüäåñÿò ìèëëèîíîâ", "âîñåìüäåñÿò ìèëëèîíîâ", "äåâÿíîñòî ìèëëèîíîâ", "ñòî ìèëëèîíîâ", _
"äâåñòè ìèëëèîíîâ", "òðèñòà ìèëëèîíîâ", "÷åòûðåñòà ìèëëèîíîâ", "ïÿòüñîò ìèëëèîíîâ", "øåñòüñîò ìèëëèîíîâ", "ñåìüñîò ìèëëèîíîâ", "âîñåìüñîò ìèëëèîíîâ", "äåâÿòüñîò ìèëëèîíîâ", "îäíà òûñÿ÷à", _
"äâå òûñÿ÷è", "òðè òûñÿ÷è", "÷åòûðå òûñÿ÷è", "ïÿòü òûñÿ÷", "øåñòü òûñÿ÷", "ñåìü òûñÿ÷", "âîñåìü òûñÿ÷", "äåâÿòü òûñÿ÷", "äåñÿòü òûñÿ÷", _
"îäèííàäöàòü òûñÿ÷", "äâåíàäöàòü òûñÿ÷", "òðèíàäöàòü òûñÿ÷", "÷åòûðíàäöàòü òûñÿ÷", "ïÿòíàäöàòü òûñÿ÷", "øåñòíàäöàòü òûñÿ÷", "ñåìíàäöàòü òûñÿ÷", "âîñåìíàäöàòü òûñÿ÷", "äåâÿòíàäöàòü òûñÿ÷", _
"äâàäöàòü òûñÿ÷", "òðèäöàòü òûñÿ÷", "ñîðîê òûñÿ÷", "ïÿòüäåñÿò òûñÿ÷", "øåñòüäåñÿò òûñÿ÷", "ñåìüäåñÿò òûñÿ÷", "âîñåìüäåñÿò òûñÿ÷", "äåâÿíîñòî òûñÿ÷", "òûñÿ÷", _
"ñòî", "äâåñòè", "òðèñòà", "÷åòûðåñòà", "ïÿòüñîò", "øåñòüñîò", "ñåìüñîò", "âîñåìüñîò", "äåâÿòüñîò", _
"íîëü", "îäèí", "äâà", "òðè", "÷åòûðå", "ïÿòü", "øåñòü", "ñåìü", "âîñåìü", _
"äåâÿòü", "äåñÿòü", "îäèííàäöàòü", "äâåíàäöàòü", "òðèíàäöàòü", "÷åòûðíàäöàòü", "ïÿòíàäöàòü", "øåñòíàäöàòü", "ñåìíàäöàòü", _
"âîñåìíàäöàòü", "äåâÿòíàäöàòü", "äâàäöàòü", "òðèäöàòü", "ñîðîê", "ïÿòüäåñÿò", "øåñòüäåñÿò", "ñåìüäåñÿò", "âîñåìüäåñÿò", _
"äåâÿíîñòî", "", "äîëë.ÑØÀ", "åâðî", "ðóá.", "ÿíâàðÿ", "ôåâðàëÿ", "ìàðòà", "àïðåëÿ", _
"ìàÿ", "èþíÿ", "èþëÿ", "àâãóñòà", "ñåíòÿáðÿ", "îêòÿáðÿ", "íîÿáðÿ", "äåêàáðÿ")
Application.ScreenUpdating = False  ' Çàïðåùàåì îáíîâëåíèå ýêðàíà âî âðåìÿ ðàáîòû ìàêðîñà
With rDoc.Find
'çàìåíÿåì âñå ëàòèíñêèå ñèìâîëû íà ñîîòâåòñòâóþùèå êèðèëëè÷åñêèå
   .ClearFormatting
   .Replacement.ClearFormatting
   .Forward = True
   .Wrap = wdFindStop
   .MatchWildcards = False
   .Format = True
   .MatchCase = True
   For i = LBound(sLat) To UBound(sRus)
      .Text = sLat(i)
      .Replacement.Text = sRus(i)
      .Execute Replace:=wdReplaceAll
   Next i
End With
Application.ScreenUpdating = True  ' Îáíîâëÿåì ýêðàí
End Sub

3

Re: Нужна помощь

Попробуйте так, может быстрее будет:
1) создаем коллекцию (Collection), где ключ (Key) - английское слово, значение (Item) - его русский эквивалент
2) в цикле перебираем слова документа от начала к его концу
3) очередное слово ищем по ключу в коллекции, и заменяем если нашли.

Можно прикрутить онлайн-переводчик. Их много сейчас, с большим количеством слов для бесплатного перевода.

Макросы под заказ и готовый пакет - mtdmacro.ru

4

Re: Нужна помощь

Не сталкивался с коллекциями sad Это как   ? Пару строк если не тяжело , или линк на чтиво .

5

Re: Нужна помощь

Sub Вождь()

    ' формируем коллекцию, ключи в нижнем регистре!
Dim C As New Collection

    C.Add Item:="один", Key:="one"
    C.Add Item:="два", Key:="two"
    ' ...
    
Dim W As Range, R As Range
Dim S As String, S2 As String

    ' перебор слов документа
    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
        ' можно добавить коррекцию регистра S2 по S
        ' ...
        ' заменяем
        R.Text = S2
NEXTW:  ' следующее слово
    Next W
    
End Sub
Макросы под заказ и готовый пакет - mtdmacro.ru

6

Re: Нужна помощь

Огромное спасибо ,мне необходимо в ключах верхний регистр ( Сильно страшно ) проверил
не страшно )

А вот поиск слова "Blabla Ololo " (2 Слова с Заглавной буквы)  не приводит к результату  sad

7

Re: Нужна помощь

MikhailVAS пишет:

Огромное спасибо ,мне необходимо в ключах верхний регистр ( Сильно страшно ) проверил
не страшно )

1)А вот поиск слова "Blabla Ololo " (2 Слова с Заглавной буквы)  не приводит к результату  sad

  2)  C.Add Item:="одна тысяча",Key:="One Thousand"
       C.Add Item:="две тысячи",Key:="Two Thousand"

Вот в чём проблемы (