0

Обрабатываю прайс лист и столкнулся со следующей задачей: Нужно перевести цвета и описание товара с другого языка. На пример тут

(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

2 ответа 2

1

Скрипт берет данные с листов 1 и 3, в полученном с первого листа втором столбце заменяет текст первого столбца третьего листа на текст второго столбца третьего листа. Далее складывает модифицированные данные второго столбца первого листа в словарь, используя значения из первого столбца в качестве ключа, после чего использует словарь для заполнения второго столбца второго листа.

6
  • я понимаю что ответ верный, и я это уже сам понимаю и вижу прошёлся по макросу StepIn`ами, но не понимаю как сделать чтобы он записал в словарь не "модифицированные данные второго столбца первого листа в словарь, используя значения из первого столбца в качестве ключа", а просто первый столбец второго листа т.е. переводил сразу без всяких ключей.
    – Ivanius
    13 июл 2014 в 13:40
  • У вас выше есть пример: Application.VLookup(str2, Range("lingvo"), 2, 0) ' переводим текущее слово
    – maxleo
    13 июл 2014 в 13:42
  • нет именно то что вы описали нужно поменять, т.к. тут используются именно замена выражений, а не слов. я попробовал поменять чтобы он брал данные сразу со второго листа первого столбца и заменял текст первого столбца третьего листа на текст второго столбца третьего листа. Но он все-равно использует ключ, а т.к. ключа нету - не выводит ничего.
    – Ivanius
    13 июл 2014 в 13:46
  • Так они должен переводить выражения - должно быть не розовый и точки, а розовый в горошек.
    – maxleo
    13 июл 2014 в 13:54
  • он то заменяет, но для этого мне нужно на первом листе сделать 2 одинаковых столбца которые совпадают с первым столбцом второго листа и я хочу этого избежать, можно вас попросить переписать макрос для двух листов и немного прокомментировать или хотя бы добавить выход и внутреннего цикла a(i, 1) = Replace(a(i, 1), b(ii, 1), b(ii, 2)), если замена произошла т.е. он нашел совпадение. Добавил сам выход из цикла, но переделать не получается.
    – Ivanius
    13 июл 2014 в 14:00
0

Вот так вот работает для 2х листов, вроде все отлично - разобрался

Sub tt()
    Dim a(), b(), i&, ii&, buf$
'   a = Sheets(1).[a1].CurrentRegion.Value
    b = Sheets(2).[a1].CurrentRegion.Value
'простым перебором и заменой :
'    For i = 1 To UBound(a)
'        For ii = 1 To UBound(b)
'            buf$ = a(i, 1)
'            a(i, 1) = Replace(a(i, 1), b(ii, 1), b(ii, 2))
'            If a(i, 1) <> buf$ Then Exit For
'        Next
'    Next
'с помощью словаря
    With CreateObject("scripting.dictionary")
        For i = 1 To UBound(b): .Item(b(i, 1)) = b(i, 2): Next
        a = Sheets(1).[a1].CurrentRegion.Value
        For i = 1 To UBound(a)
            If .exists(a(i, 1)) Then a(i, 2) = .Item(a(i, 1))
        Next
        Sheets(1).[a1].CurrentRegion.Value = a
    End With
End Sub

А вот функцию из этого сделать не получаеться

Ваш ответ

Нажимая на кнопку «Отправить ответ», вы соглашаетесь с нашими пользовательским соглашением, политикой конфиденциальности и политикой о куки

Всё ещё ищете ответ? Посмотрите другие вопросы с метками или задайте свой вопрос.