Дополнить Макрос-Переводчик, чтобы "просматривал" все листы

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Дополнить Макрос-Переводчик, чтобы "просматривал" все листы (Макросы/Sub)

dimakdd

Дата: Четверг, 30.11.2017, 19:56 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 7

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

Здравствуйте. Есть "Макрос-Переводчик", который "просматривает" ячейки на листе 2 (в моём примере лист "Men"), и, если видит совпадения на листе 1 (листе "All"), то на листе 1 меняет содержание ячейки на текст ближайшей правой ячейки с листа 2.

[vba]

Код

Sub Translate()
Dim cell1 As Range, cell2 As Range
Dim i As Long, Langs As Long

For Each cell1 In ActiveSheet.Cells.SpecialCells(xlCellTypeConstants)
For Each cell2 In Worksheets("Men").Cells.SpecialCells(xlCellTypeConstants)
If cell1.Value = cell2.Value Then
i = cell2.Column
If i = Langs Then i = 1 Else i = i + 1
cell1.Value = Worksheets("Men").Cells(cell2.Row, i).Value
GoTo 1
End If
Next cell2
1: Next cell1

End Sub

[/vba]

Возможно ли Макрос сократить? Т.е. мне нужно: ввёл в ЛЮБУЮ ячейку на лист 1, и если на любом из остальных листов есть точное совпадение, то содержание ячейки на листе 1 заменяется на значение из ближайшей правой ячейки с другого листа.

БАЗОВЫЙ ЖЕ ВОПРОС - Как сделать, чтобы Макрос просматривал ВСЕ листы, которые созданы в книге?? При этом, названия у листов могут быть разные.

P.S. помогаете Доброму делу. Нужно для Википедии, чтобы люди на создание таблиц после гонок тратили ни 1 час 40 минут (чтобы В РУЧНУЮ вбить 100 строчек), а 2-3 минуты :)))

Изначальная версия Макроса взята отсюда:
Макрос-переводчик
http://www.planetaexcel.ru/techniques/7/56/

[vba]

Код

Sub Translate()
Dim cell1 as Range, cell2 As Range
Dim i as Long, Langs As Long

Langs = 3 'количество языков перевода, включая русский

    For Each cell1 In ActiveSheet.Cells.SpecialCells(xlCellTypeConstants)
        For Each cell2 In Worksheets("Словарь").Cells.SpecialCells(xlCellTypeConstants)
            If cell1.Value = cell2.Value Then
                i = cell2.Column
                If i = Langs Then i = 1 Else i = i + 1
                cell1.Value = Worksheets("Словарь").Cells(cell2.Row, i).Value
                GoTo 1
            End If
        Next cell2
1:   Next cell1

End Sub

[/vba]

Код

[/vba]dimakdd

К сообщению приложен файл: Wikipedia_-_.xls (84.5 Kb)

Сообщение отредактировал dimakdd - Четверг, 30.11.2017, 21:07

Ответить

СообщениеЗдравствуйте. Есть "Макрос-Переводчик", который "просматривает" ячейки на листе 2 (в моём примере лист "Men"), и, если видит совпадения на листе 1 (листе "All"), то на листе 1 меняет содержание ячейки на текст ближайшей правой ячейки с листа 2.

[vba]

Код

[/vba]

Автор - dimakdd
Дата добавления - 30.11.2017 в 19:56

Manyasha

Дата: Четверг, 30.11.2017, 21:46 | Сообщение № 2

Группа: Модераторы

Ранг: Старожил

Сообщений: 2198

Репутация: 898 ±

Замечаний: 0% ±

Excel 2010, 2016

dimakdd, здравствуйте, попробуйте так:
код в модуле листа
[vba]

Код

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sh, res As Range
    If Target.Count > 1 Then Exit Sub
    If Target = "" Then Exit Sub

    For Each sh In ThisWorkbook.Sheets
        If sh.Name <> "All" Then
            Set res = sh.Cells.Find(What:=Target.Value, LookAt:=xlWhole, MatchCase:=True)
            If Not res Is Nothing Then
                If res <> "" Then
                    Application.EnableEvents = False
                    Target.Value = res.Offset(, 1).Value
                    Application.EnableEvents = True
                    Exit For
                End If
            End If
        End If
    Next sh
End Sub

[/vba]