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

Вход

Регистрация

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

 

= Мир MS Excel/Взаимный конвертер валют - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_, DrMini  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Взаимный конвертер валют (Макросы/Sub)
Взаимный конвертер валют
ant6729 Дата: Суббота, 17.02.2018, 02:15 | Сообщение № 1
Группа: Проверенные
Ранг: Ветеран
Сообщений: 533
Репутация: 2 ±
Замечаний: 40% ±

Excel 2010
Всем добрый вечер.
Возможно, кто-то сталкивался с взаимным конвертером валют?
Я как не пытался - все время попадаю в циклический процесс.
Возможно ли в Excel сделать, как вот здесь?
https://yandex.by/yandsea....9%D0%BD

Яндекс конвертер валют

Когда вносишь вверху - конвертирует внизу.
Когда вносишь внизу - конвертирует вверху.

Я получается, пишу если в первой один, во второй автоматически ставится 3. Теперь обратно расписываю: если во второй ставлю 3 - тогда в первой автоматически ставится 1. И тут понеслась... процедура видит изменение в первой - меняет вторую, видит изменения во второй - меняет в первой и так далее понеслось...

Вот эту ситуацию не могу обойти))

Вот пример кода
В А доллары
В В русские

[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
lr = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

If Not Intersect(Target, Range("А8:А" & lr)) Is Nothing Then
Target.Offset(0, 1).Value = Target / Cells(1, 7).Value' ячейка, в которой курс
End If
End Sub
[/vba]
 
Ответить
СообщениеВсем добрый вечер.
Возможно, кто-то сталкивался с взаимным конвертером валют?
Я как не пытался - все время попадаю в циклический процесс.
Возможно ли в Excel сделать, как вот здесь?
https://yandex.by/yandsea....9%D0%BD

Яндекс конвертер валют

Когда вносишь вверху - конвертирует внизу.
Когда вносишь внизу - конвертирует вверху.

Я получается, пишу если в первой один, во второй автоматически ставится 3. Теперь обратно расписываю: если во второй ставлю 3 - тогда в первой автоматически ставится 1. И тут понеслась... процедура видит изменение в первой - меняет вторую, видит изменения во второй - меняет в первой и так далее понеслось...

Вот эту ситуацию не могу обойти))

Вот пример кода
В А доллары
В В русские

[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
lr = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

If Not Intersect(Target, Range("А8:А" & lr)) Is Nothing Then
Target.Offset(0, 1).Value = Target / Cells(1, 7).Value' ячейка, в которой курс
End If
End Sub
[/vba]
Автор - ant6729
Дата добавления - 17.02.2018 в 02:15
Апострофф Дата: Суббота, 17.02.2018, 02:36 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 468
Репутация: 129 ±
Замечаний: 0% ±

Excel 1997
ant6729, курим ENABLEEVENTS.
 
Ответить
Сообщениеant6729, курим ENABLEEVENTS.
Автор - Апострофф
Дата добавления - 17.02.2018 в 02:36
Karataev Дата: Суббота, 17.02.2018, 10:17 | Сообщение № 3
Группа: Проверенные
Ранг: Старожил
Сообщений: 1342
Репутация: 535 ±
Замечаний: 0% ±

Excel
Я сделал то, что предложено в посте 2. Плюс еще оптимизировал макрос для удобства чтения кода:
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("А8:А" & lr)) Is Nothing Then Exit Sub
    lr = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    Application.EnableEvents = False
    Target.Offset(0, 1).Value = Target / Cells(1, 7).Value ' ячейка, в которой курс
    Application.EnableEvents = True
End Sub
[/vba]
 
Ответить
СообщениеЯ сделал то, что предложено в посте 2. Плюс еще оптимизировал макрос для удобства чтения кода:
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("А8:А" & lr)) Is Nothing Then Exit Sub
    lr = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    Application.EnableEvents = False
    Target.Offset(0, 1).Value = Target / Cells(1, 7).Value ' ячейка, в которой курс
    Application.EnableEvents = True
End Sub
[/vba]
Автор - Karataev
Дата добавления - 17.02.2018 в 10:17
ant6729 Дата: Суббота, 17.02.2018, 12:47 | Сообщение № 4
Группа: Проверенные
Ранг: Ветеран
Сообщений: 533
Репутация: 2 ±
Замечаний: 40% ±

Excel 2010
О, Господи... честно
Чуть не помер, пока решил, результат то молился, то матерился.

Апострофф, Karataev Спасибо за наводку!!!!

[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
lr = Sheets("Лист1").Cells(Rows.Count, 1).End(xlUp).Row

If Not Intersect(Target, Range("A2:A" & lr)) Is Nothing Then

Application.EnableEvents = False

Target.Offset(0, 1).Value = Target * Range("G1")
Application.EnableEvents = True
End If

If Not Intersect(Target, Range("B2:B" & lr)) Is Nothing Then

Target.Offset(0, -1).Value = Target / Range("G1")

End If
End Sub
[/vba]
Возможно, можно оптимизировать, но в принципе, работает!, Спасибо!
К сообщению приложен файл: _USD.xlsm (14.6 Kb)
 
Ответить
СообщениеО, Господи... честно
Чуть не помер, пока решил, результат то молился, то матерился.

Апострофф, Karataev Спасибо за наводку!!!!

[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
lr = Sheets("Лист1").Cells(Rows.Count, 1).End(xlUp).Row

If Not Intersect(Target, Range("A2:A" & lr)) Is Nothing Then

Application.EnableEvents = False

Target.Offset(0, 1).Value = Target * Range("G1")
Application.EnableEvents = True
End If

If Not Intersect(Target, Range("B2:B" & lr)) Is Nothing Then

Target.Offset(0, -1).Value = Target / Range("G1")

End If
End Sub
[/vba]
Возможно, можно оптимизировать, но в принципе, работает!, Спасибо!
Автор - ant6729
Дата добавления - 17.02.2018 в 12:47
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Взаимный конвертер валют (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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