Создание простого переводчика таблицы

@Cigurd · Регистрация: 29.08.2010

Студворк — интернет-сервис помощи студентам

Гуру, помогите плиз ещё разок.

Я честно пытался, читал, читал, но опять ничего не вышло, выдаёт какую то ошибку, а что делать не знаю.
Итак, задача для вас довольна проста: Прогон текста одной страницы со значениями другой (см. приложение)

На первой странице есть какой-то текст, а на второй две колонки, в одной этот же текст, а в другой его перевод. Надо чтобы макрос нашел этот текст и заменил его в искомой графе, если же его НЕТ, то пропустил ячейку (В идеале было бы не плохо если бы он её выделил цветом). Объем текста на первой странице переменный.

Чтобы доказать что я пытался вот что у меня получилось (естественно не работающий вариант):

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub Looping()
i = 3 'вторая линия
q = 1 'для обозначения столбца
Range("A2").Select
Do ' первый контур по вертикали
    Do ' Второй контур по горизонтали
        J = 0
        Do
        J = J + 1 ' присваивание адреса первой ячейки
        Loop Until Worksheets("Sheet1").Cells("A" & q) = Worksheets("Sheet2").Cells("A" & J) ' пока искомая не будет равна ячейке во втором листе продолжать искать, адрес ячейки на втором листе меняется
        Worksheets("Sheet1").Cells("A" & q) = Worksheets("sheet2").Cells("B" & J)
    
    ActiveCell.Offset(0, 1).Select ' передвижение ячейки на одну влево
    Loop Until IsEmpty(ActiveCell.Offset(0, 0)) ' условие конца цикла: если клетка пустая - переместить на одну клетку вниз
Range("A" & i).Select 'выделение первой колонки следующей строчки
i = i + 1 'прибавление № следующей строки
q = q + 1
Loop Until IsEmpty(ActiveCell.Offset(0, 0)) 'условие конца цикла: если клетка пустая - закончить работу
 
End Sub

@Cigurd · 02.09.2010, 10:30 **[ТС]**

Млин, я уже какими только вариантами не пытался подставить, но все равно в упор не хочет сравнивать, просто пропускает. Что я делаю не так?
Люди подскажите какая функция проверяет текст на соответствие?

@analyst · 02.09.2010, 11:03

Сообщение от Cigurd

Люди подскажите какая функция проверяет текст на соответствие?

В коде есть ошибка:

Visual Basic
1
2
LOOP UNTIL Worksheets("Sheet1").Cells("A" & q)= Worksheets("Sheet2").Cells("A" & J) ' пока искомая не будет равна ячейке во втором листе продолжать искать, адрес ячейки на втором листе меняется
        Worksheets("Sheet1").Cells("A" & q) = Worksheets("sheet2").Cells("B" & J)

Странно, что это вообще как-то работает.
Вообще нужно попробовать сделать так:

Visual Basic
1
2
LOOP UNTIL Worksheets("Sheet1").Cells(1,q) = Worksheets("Sheet2").Cells(1,J) ' пока искомая не будет равна ячейке во втором листе продолжать искать, адрес ячейки на втором листе меняется
        Worksheets("Sheet1").Cells(1,q) = Worksheets("sheet2").Cells(2,J)

@Cigurd · 02.09.2010, 11:11 **[ТС]**

Ненаходит

просто пропускает и продолжает дальше искать

@analyst · 02.09.2010, 11:47

Сообщение от Cigurd

Ненаходит

просто пропускает и продолжает дальше искать

Да. Теперь разобрался что нужно.
Можно начать так:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub Translation()
Rem нужно считать данные из второго листа в массив
 
Rem Можно считать все ячейки первого листа и выполнить перевод в памяти, _
но можно сделать это на листе как здесь
With ActiveWorkbook.Sheets(1)
Dim rng As Range
    Set rUsedRange = ActiveSheet.UsedRange
    For Each rng In rUsedRange
        Rem запускаем цикл по массиву для нахождения слова и перевода_
        и переводим
    Next rng
 
End With
 
End Sub

Сейчас писать весь код некогда.

@Cigurd · 02.09.2010, 12:00 **[ТС]**

Спасибо за помощь, но я так и не знаю как их сравнить, т.е. массив в принципе и прошлый работал (хотя твой наверно лучше), а вот сравнение у меня не получилось?

Пожалуйста напиши как будет время.

@petr-sev · 02.09.2010, 12:55

а вот есче мой вариант

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Option Explicit
Sub NN()
Dim I As Long
Dim J As Long
Dim Tmp As Object
Application.DisplayAlerts = False
With Worksheets("Sheet1")
For I = 1 To .UsedRange.Rows.Count
    For J = 1 To .UsedRange.Columns.Count
        Worksheets("Sheet2").Activate
        Set Tmp = Cells.Find(What:=.Cells(I, J).Text, LookAt:=xlWhole)
        If Tmp Is Nothing Then
           .Cells(I, J).Font.Color = RGB(255, 0, 0)
        Else
           .Cells(I, J) = Cells(Tmp.Row, 2).Text
        End If
    Next
Next
End With
Worksheets("Sheet1").Activate
Application.DisplayAlerts = True
Set Tmp = Nothing
End Sub

@analyst · 02.09.2010, 13:00

Вот другой вариант:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Sub Translation()
Dim VTranslationArr() As Variant, VDataArr() As Variant
 
Worksheets("Sheet2").Select
Cells(1, 1).Select
VTranslationArr = ActiveCell.CurrentRegion
 
Worksheets("Sheet1").Select
Cells(1, 1).Select
VDataArr = ActiveCell.CurrentRegion
For iRow = LBound(VDataArr, 1) To UBound(VDataArr, 1)
    For iColumn = LBound(VDataArr, 2) To UBound(VDataArr, 2)
        FlagTranslation = 0
        For iRowTr = LBound(VTranslationArr, 1) To UBound(VTranslationArr, 1)
            If VDataArr(iRow, iColumn) = VTranslationArr(iRowTr, LBound(VTranslationArr, 1)) Then
                VDataArr(iRow, iColumn) = VTranslationArr(iRowTr, 2)
                FlagTranslation = 1
            End If
        Next iRowTr
        If FlagTranslation = 0 Then Worksheets("Sheet1").Cells(iRow, iColumn).Interior.Color = 255
    Next iColumn
Next iRow
Worksheets("Sheet1").Select
Cells(1, 1).Select
ActiveCell.CurrentRegion = VDataArr
End Sub

@Cigurd · 02.09.2010, 15:02 **[ТС]**

ОГРОМНОЕ ВСЕМ СПАСИБО!!!!

Код Аналитика почему то не работает ставит что-то типа "#NAME?", плюс массив всегда разный.

А код Analyst - работает, но я вообще не могу понять как он работает )))

Я взял вариант petr-sev, т.к. код - понятен и в принципе прост.

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

А у petr-sev если система находит пустую клетку в Sheet1 она в неё вставляет значение первой строки второго столбца из Sheet2.

Есть мысль как это исправить? Я сегодня ещё посижу подумаю, но если до завтра не придумаю, то не могли бы вы ещё помочь?

Кстати идея аналитика по поводу добавления в словарь, очень хорошая, однако проблема в том что файлик который я с вашей помощью готовлю будут использовать люди без знания языка. Поэтому функцию может и стоит прописать, но не как условие, а как дополнение, но это конечно усложняет задачу которую я итак без вас решить не могу.

И ещё вопрос, есть ли функция проверки языка ввода? Ну т.е. если язык русский уже то находить перевод не надо?

P.S. Ещё раз огромное спасибо.

С уважением,
Женя

@petr-sev · 02.09.2010, 15:15

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

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Option Explicit
Sub NN()
Dim I As Long
Dim J As Long
Dim Tmp As Object
Application.DisplayAlerts = False
With Worksheets("Sheet1")
For I = 1 To .UsedRange.Rows.Count
    For J = 1 To .UsedRange.Columns.Count
        If .Cells(I, J).Text <> "" Then
           Worksheets("Sheet2").Activate
           Set Tmp = Cells.Find(What:=.Cells(I, J).Text, LookAt:=xlWhole)
           If Tmp Is Nothing Then
              .Font.Color = RGB(255, 0, 0)
           Else
              .Cells(I, J) = Cells(Tmp.Row, 2).Text
           End If
        End If
    Next
Next
End With
Worksheets("Sheet1").Activate
Application.DisplayAlerts = True
Set Tmp = Nothing
End Sub

@Cigurd · 03.09.2010, 07:44 **[ТС]**

Все работает. Спасибо большое, но ещё одни вопрос на эту же тему:

Какой размер у параметра Range?

Дело в том что текст: "Без присмотра разрешается оставлять только ту технику, которая завязана на систему выключения, и которая пригодна для эксплуатации без присмотра. Если техника не пригодна для эксплуатации без присмотра, то такое машинное оборудование следует проверять на регулярной основе." он не "переводит", и ругается: "Run time error 13: Type mismatch"
Но если текст сократить, то "переводит", т.е. получается что есть ограничение на размер текста.

В книжке написано Object = 4 byte = Any object reference.

Long = 4 byte = от -2 147 483 648 до 2 147 483 647

А это очень много, т.е. текст должен поместиться, но ошибка возникает. Можно её как то решить?

Добавлено через 2 часа 34 минуты

Сообщение от Cigurd

Какой размер у параметра Range?

Сорри не Range, а Object

@petr-sev · 03.09.2010, 10:53

Дело не в размере Range или Object, а в том, что для перевода использован метод Find (поиск)
а поиск (в том числе и поиск вручную) в Excel'е работает только для строк длиной не более 256 символов

@Cigurd · 03.09.2010, 14:26 **[ТС]**

Тогда придется использовать вариант Analyst, но тогда остается вопрос пропуска пустых ячеек. В принципе я заменил заливку на изменение цвета текста, и т.к. клетки пустые то их и не видно, но может можно как то правильнее сделать?
Я попробовал по аналогии вставить:

If VDataArr(iRow, iColomn).Text <> "" Then

Но система это принимать не хочет "Script out of range". Подскажете как решить?
Вот получившийся код:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Sub Translation()
Dim VTranslationArr() As Variant, VDataArr() As Variant
 
Worksheets("Sheet2").Select
Cells(1, 1).Select
VTranslationArr = ActiveCell.CurrentRegion
 
Worksheets("Sheet1").Select
Cells(1, 1).Select
VDataArr = ActiveCell.CurrentRegion
For iRow = LBound(VDataArr, 1) To UBound(VDataArr, 1)
    For iColumn = LBound(VDataArr, 2) To UBound(VDataArr, 2)
        FlagTranslation = 0
        If VDataArr(iRow, iColomn).Text <> "" Then
            For iRowTr = LBound(VTranslationArr, 1) To UBound(VTranslationArr, 1)
                If VDataArr(iRow, iColumn) = VTranslationArr(iRowTr, LBound(VTranslationArr, 1)) Then
                VDataArr(iRow, iColumn) = VTranslationArr(iRowTr, 2)
                FlagTranslation = 1
                End If
            Next iRowTr
        End If
        If FlagTranslation = 0 Then Worksheets("Sheet1").Cells(iRow, iColumn).Font.Color = RGB(255, 0, 0)
    Next iColumn
Next iRow
Worksheets("Sheet1").Select
Cells(1, 1).Select
ActiveCell.CurrentRegion = VDataArr
End Sub

@Cigurd · 06.09.2010, 09:20 **[ТС]**

Чё то я не нашел решения. Помогите плиз.

@analyst · 06.09.2010, 09:50

Сообщение от Cigurd

Тогда придется использовать вариант Analyst, но тогда остается вопрос пропуска пустых ячеек. В принципе я заменил заливку на изменение цвета текста, и т.к. клетки пустые то их и не видно, но может можно как то правильнее сделать?
Я попробовал по аналогии вставить:
If VDataArr(iRow, iColomn).Text <> "" Then

Попробуйте задать условие так:
If VDataArr(iRow, iColomn) <> Empty Then
Мой код не сможет перевести предложение потому, что вы не указывали в условии необходимость это сделать. Для решения этой задачи необходимо модифицировать код!

Новые блоги и статьи Все статьи Все блоги /
Сумматор с применением элементов трёх состояний. Hrethgir 26.03.2026 Тут. https:/ / fips. ru/ EGD/ ab3c85c8-836d-4866-871b-c2f0c5d77fbc Первый документ красиво выглядит, но без схемы. Это конечно не даёт никаких плюсов автору, но тем не менее. . . всё может быть. . .	Автозаполнение реквизитов при создании документа Maks 26.03.2026 Программный код из решения ниже размещается в модуле объекта документа, в процедуре "ПриСозданииНаСервере". Алгоритм проверки заполнения реализован для исключения перезаписи значения реквизита,. . .	Команды "Заполнить" и "Очистить" на форме документа Maks 26.03.2026 1. Команда формы "ЗаполнитьЗапчасти". На примере нетипового документа "ЗаявкаНаРемонтСпецтехники" разработанного в конфигурации КА2. В качестве источника данных выбран регистр накопления, в. . .	Кому нужен AOT? DevAlt 26.03.2026 Решил сделать простой ланчер Написал заготовку: dotnet new console --aot -o UrlHandler var items = args. Split(":"); var tag = items; var id = items; var executable = args;. . .
Отправка уведомления на почту при изменении наименования справочника Maks 24.03.2026 Программная отправка письма электронной почты на примере изменения наименования типового справочника "Склады" в конфигурации БП3. Перед реализацией необходимо выполнить настройку системной учетной. . .	модель ЗдравоСохранения 5. Меньше увольнений- больше дохода! anaschu 24.03.2026 Теперь система здравосохранения уменьшает количество увольнений. 9TO2GP2bpX4 a42b81fb172ffc12ca589c7898261ccb/ https:/ / rutube. ru/ video/ a42b81fb172ffc12ca589c7898261ccb/ Слева синяя линия -. . .	Midnight Chicago Blues kumehtar 24.03.2026 Такой Midnight Chicago Blues, знаешь?. . Когда вечерние улицы становятся ночными, а ты не можешь уснуть. Ты идёшь в любимый старый бар, и бармен наливает тебе виски. Ты смотришь на пролетающие. . .	SDL3 для Desktop (MinGW): Вывод текста со шрифтом TTF с помощью библиотеки SDL3_ttf на Си и C++ 8Observer8 24.03.2026 Содержание блога Финальные проекты на Си и на C++: finish-text-sdl3-c. zip finish-text-sdl3-cpp. zip

@Cigurd 0 / 0 / 0 Регистрация: 29.08.2010 Сообщений: 18
	02.09.2010, 10:30 [ТС]
	Млин, я уже какими только вариантами не пытался подставить, но все равно в упор не хочет сравнивать, просто пропускает. Что я делаю не так? Люди подскажите какая функция проверяет текст на соответствие? 0

@Cigurd 0 / 0 / 0 Регистрация: 29.08.2010 Сообщений: 18
	02.09.2010, 11:11 [ТС]
	Ненаходит просто пропускает и продолжает дальше искать 0

@Cigurd 0 / 0 / 0 Регистрация: 29.08.2010 Сообщений: 18
	02.09.2010, 12:00 [ТС]
	Спасибо за помощь, но я так и не знаю как их сравнить, т.е. массив в принципе и прошлый работал (хотя твой наверно лучше), а вот сравнение у меня не получилось? Пожалуйста напиши как будет время. 0

@Cigurd 0 / 0 / 0 Регистрация: 29.08.2010 Сообщений: 18
	02.09.2010, 15:02 [ТС]
	ОГРОМНОЕ ВСЕМ СПАСИБО!!!! Код Аналитика почему то не работает ставит что-то типа "#NAME?", плюс массив всегда разный. А код Analyst - работает, но я вообще не могу понять как он работает ))) Я взял вариант petr-sev, т.к. код - понятен и в принципе прост. Однако в обоих вариантах нашелся баг: У Analyst система выделяет пустую строчку, как если бы она не нашла соответствия. А у petr-sev если система находит пустую клетку в Sheet1 она в неё вставляет значение первой строки второго столбца из Sheet2. Есть мысль как это исправить? Я сегодня ещё посижу подумаю, но если до завтра не придумаю, то не могли бы вы ещё помочь? Кстати идея аналитика по поводу добавления в словарь, очень хорошая, однако проблема в том что файлик который я с вашей помощью готовлю будут использовать люди без знания языка. Поэтому функцию может и стоит прописать, но не как условие, а как дополнение, но это конечно усложняет задачу которую я итак без вас решить не могу. И ещё вопрос, есть ли функция проверки языка ввода? Ну т.е. если язык русский уже то находить перевод не надо? P.S. Ещё раз огромное спасибо. С уважением, Женя 0

@petr-sev 496 / 130 / 19 Регистрация: 30.03.2010 Сообщений: 224
	03.09.2010, 10:53
	Дело не в размере Range или Object, а в том, что для перевода использован метод Find (поиск) а поиск (в том числе и поиск вручную) в Excel'е работает только для строк длиной не более 256 символов 0

@Cigurd 0 / 0 / 0 Регистрация: 29.08.2010 Сообщений: 18
	06.09.2010, 09:20 [ТС]
	Чё то я не нашел решения. Помогите плиз. 0