Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

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

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир 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]
К сообщению приложен файл: Wikipedia_-_.xls(84Kb)


Сообщение отредактировал dimakdd - Четверг, 30.11.2017, 21:07
 
Ответить
СообщениеЗдравствуйте. Есть "Макрос-Переводчик", который "просматривает" ячейки на листе 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]

Автор - dimakdd
Дата добавления - 30.11.2017 в 19:56
Manyasha Дата: Четверг, 30.11.2017, 21:46 | Сообщение № 2
Группа: Модераторы
Ранг: Старожил
Сообщений: 2028
Репутация: 843 ±
Замечаний: 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]
К сообщению приложен файл: Wikipedia-1.xls(96Kb)


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщение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]

Автор - Manyasha
Дата добавления - 30.11.2017 в 21:46
dimakdd Дата: Пятница, 01.12.2017, 00:29 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Manyasha, Спасибо за отзыв. Однако Макрос выдаёт ошибку:

Compile Error:
Expected End Sub
 
Ответить
СообщениеManyasha, Спасибо за отзыв. Однако Макрос выдаёт ошибку:

Compile Error:
Expected End Sub

Автор - dimakdd
Дата добавления - 01.12.2017 в 00:29
Manyasha Дата: Пятница, 01.12.2017, 18:06 | Сообщение № 4
Группа: Модераторы
Ранг: Старожил
Сообщений: 2028
Репутация: 843 ±
Замечаний: 0% ±

Excel 2010, 2016
dimakdd, даже в моем файле?
макрос точно целиком скопировали к себе?


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщениеdimakdd, даже в моем файле?
макрос точно целиком скопировали к себе?

Автор - Manyasha
Дата добавления - 01.12.2017 в 18:06
dimakdd Дата: Суббота, 02.12.2017, 00:03 | Сообщение № 5
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Manyasha, РАБОТАЕТ :D :D Работает именно в Вашем файле. Значит это я при копировании в свой документ допустил ошибку.
Хвала ВАМ И ВАШЕМУ ФОРУМУ :))
 
Ответить
СообщениеManyasha, РАБОТАЕТ :D :D Работает именно в Вашем файле. Значит это я при копировании в свой документ допустил ошибку.
Хвала ВАМ И ВАШЕМУ ФОРУМУ :))

Автор - dimakdd
Дата добавления - 02.12.2017 в 00:03
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Дополнить Макрос-Переводчик, чтобы "просматривал" все листы (Макросы/Sub)
Страница 1 из 11
Поиск:

Яндекс цитирования
© 2010-2017 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!