Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Автоматический перевод ячейки с данными в расчётную и наоборот.
 
#1
24.07.2022 11:05:17
Добрый день.
Итак, есть две ячейки. Допустим С1 и С2. Цель - если ввожу данные в ячейку С1, то содержимое С2 должно заменяться на формулу "= С1 + 1". И наоборот, если ввожу данные в ячейку С2, то содержимое С1 должно замениться на формулу "= С2 + 2". Формулы для примера...  
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C1")) Is Nothing Then
    Range("C2").Formula = "=C1+1"
End If

If Not Intersect(Target, Range("C2")) Is Nothing Then
    Range("C1").Formula = "=C2+2"
End If
End Sub
такая структура приводит к зацикливанию, что естественно, но как уйти от этого не придумывается...
Изменено: tutochkin - 24.07.2022 11:05:50
 
 
 
#2
24.07.2022 11:49:35
Код
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
  If Intersect(Target, Range("C1:C2")) Is Nothing Then Exit Sub
  Application.EnableEvents = False
  Dim r&: r = Target.Row
  Cells(3 - r, 3).FormulaR1C1 = "=R" & r & "C+" & r
  Application.EnableEvents = True
End Sub
если пользователь переключится в R1C1 это "=C2+2" - рухнет
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#3
24.07.2022 13:54:28
Цитата
Ігор Гончаренко написал:
если пользователь переключится в R1C1 это "=C2+2" - рухнет
Должно устоять. Свойство Range.Formula задается в A1 нотации. Вот Application.Evaluate страдает этой болезнью, вопреки документации.  :)
Владимир
 
 
 
#4
24.07.2022 14:30:58
Ігор Гончаренко, большое спасибо.
Я как то так сделал:
Код
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
  If Intersect(Target, Range("C2:C3")) Is Nothing Then Exit Sub
  Application.EnableEvents = False
  Dim r&: r = Target.Row
  If r = 2 Then
    Cells(3, 3).FormulaR1C1 = "=ROUND(Салават_Go_по_Ррст(R" & r & "C),2)"
  Else
    Cells(2, 3).FormulaR1C1 = "=ROUND(Салават_Ррст_по_Go(R" & r & "C),2)"
  End If
  Application.EnableEvents = True
End Sub

У меня кроме ссылок на ячейки ещё и формулы меняются...
А вот так ещё веселей :)
Код
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
  If Intersect(Target, Range("C2:C3")) Is Nothing Then Exit Sub
  Application.EnableEvents = False
  Dim r&: r = Target.Row
  If r = 2 Then
    Cells(3, 3).Value = WorksheetFunction.Round(Салават_Go_по_Ррст(Target.Value), 2)
  Else
    Cells(2, 3).Value = WorksheetFunction.Round(Салават_Ррст_по_Go(Target.Value), 2)
  End If
  Application.EnableEvents = True
End Sub
Изменено: tutochkin - 24.07.2022 14:40:11
 
 
 
#5
24.07.2022 15:08:49
всех приветствую!

Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C1")) Is Nothing Then
If Left(Cells(1, 3).FormulaR1C1, 1) <> "=" Then

   Range("C2").Formula = "=C1+1"
End If
End If

If Not Intersect(Target, Range("C2")) Is Nothing Then
If Left(Cells(2, 3).FormulaR1C1, 1) <> "=" Then
   Range("C1").Formula = "=C2+2"
End If
End If
End Sub


Можно добавить в изменяемых ячейках C1 и C2 проверку - если там формула, то есть содержимое начинается с "=", то макрос ничего не делает.
 
 
 
#6
24.07.2022 15:36:38
Валерий Соломонов, мне как раз интересно чтобы делал независимо от наличия или отсутствия формулы.
В любом случае решение меня устраивающее найдено.
https://cloud.mail.ru/public/5kNP/MvoAU9p9H
Это то, что я и хотел получить
Изменено: tutochkin - 24.07.2022 15:41:59
 
 
 
#7
24.07.2022 16:26:55
Валерий Соломонов,  код следует оформлять соответствующим тегом. Ищите кнопку <...> и исправьте своё сообщение.
 
 
 
Страницы: 1
Наверх