Обрабатываю прайс лист и столкнулся со следующей задачей: Нужно перевести цвета и описание товара с другого языка. На пример тут
(100%polyester+inside 96%polyester,4%lycra - 100%полиэстер+внутри 96%полиэстер,4%лайкра) я могу просто заменить слова на русские и будет нормально или когда
(SKIRT - юбка) или в нормальных текстах справляется GoogleTranslate (Long skirt,side cut outs,confortable fine material,beautiful combined colors at the bottom side - Длинные юбки, боковые Отрезанные выходы, удобный тонкий материал, красивые комбинированные цвета на нижней стороне)
Но почему-то гугл переводит мне PINK как PINK (певица) или еще что-то подобное. Текст макроса замены по словам:
Function RowLingvo(txt As String) As String
Dim i As Integer, str As String, str2 As String, m As String
For i = 1 To Len(txt) ' пробегаем всю фразу по буквам
m = Mid(txt, i, 1) ' берем очередную букву
If m >= "A" And m <= "z" Then ' проверяем ее на кириллицу
str2 = "" ' если кирилица то обнуляем слово
Do ' запускаем цикл для определения очередного слова
str2 = str2 & m 'приклеиваем к слову очередную буку
i = i + 1 'накручиваем счетчик
m = Mid(txt, i, 1) 'берем очередную букву
Loop While m >= "A" And m <= "z" And i <= Len(txt) ' повторять пока слово не закончилось и не закончилась фраза
i = i - 1 ' сбрасываем счетчик на 1
If IsError(Application.VLookup(str2, Range("lingvo"), 2, 0)) Then ' проверяем слово на наличие в словаре
str = str & str2 ' если слова нет, то не переводим
Else
str = str & Application.VLookup(str2, Range("lingvo"), 2, 0) ' переводим текущее слово
End If
Else
str = str & m ' если символ не кириллица, то оставляем его без изминений
End If
Next i ' следующая буква
RowLingvo = str ' возвращаем перевод
End Function
мне нужно сделать еще 3й способ замены уже выражений (регулярных) по типу:
pink and dots - розовый в горошек или BLUE AND GREEN BARS - синий в зеленую полоску т.е. я в словарь занесу еще GREEN BARS и это означает зеленая полоска есть подобный макрос, но в нем разобраться я не могу.
Sub tt()
Dim a(), b(), i&, ii&
a = Sheets(1).[a1].CurrentRegion.Value
b = Sheets(3).[a1].CurrentRegion.Value
For i = 1 To UBound(a)
For ii = 1 To UBound(b)
a(i, 2) = Replace(a(i, 2), b(ii, 1), b(ii, 2))
Next
Next
With CreateObject("scripting.dictionary")
For i = 1 To UBound(a): .Item(a(i, 1)) = a(i, 2): Next
a = Sheets(2).[a1].CurrentRegion.Value
For i = 1 To UBound(a)
If .exists(a(i, 1)) Then a(i, 2) = .Item(a(i, 1))
Next
Sheets(2).[a1].CurrentRegion.Value = a
End With
End Sub
пробовал поменять вот так, но безуспешно: Sub tt() Dim a(), b(), i&, ii&, buf$ a = Sheets(1).[a1].CurrentRegion.Value b = Sheets(3).[a1].CurrentRegion.Value
For i = 1 To UBound(a)
For ii = 1 To UBound(b)
buf$ = a(i, 2)
a(i, 2) = Replace(a(i, 2), b(ii, 1), b(ii, 2))
If a(i, 2) <> buf$ Then Exit For
Next
Next
With CreateObject("scripting.dictionary")
For i = 1 To UBound(a): .Item(a(i, 1)) = a(i, 2): Next
a = Sheets(2).[a1].CurrentRegion.Value
For i = 1 To UBound(a)
If .exists(a(i, 1)) Then a(i, 2) = .Item(a(i, 1))
Next
Sheets(2).[a1].CurrentRegion.Value = a
End With
End Sub