Несколько изменений в Excel VBA, приводящих к недостатку места в стеке - PullRequest
Новая
       9

Несколько изменений в Excel VBA, приводящих к недостатку места в стеке

0 голосов
/ 08 июня 2018

Я делаю форму для расчета цены комнат, которые мы сдаем в аренду.Среди прочего эта стоимость основана на дате прибытия и отъезда.Вы можете увидеть скриншот формы ниже;- «Aankomst» (первая дата) означает «Прибытие» - «Vertrek» (вторая дата) означает «Отъезд»

Как видите, я добавил кнопки, чтобы соответственно уменьшить или увеличить даты.Я также убедился, что невозможные значения будут исправлены.Дата отъезда никогда не может быть равной или ниже даты прибытия.При попытке уменьшить дату отправления или увеличить дату прибытия это срабатывает, если неправильно.

Input form

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

Я написал этот бит кода: 

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False


If Target.Address = "$B$5" And Range("$b$5").Value + 1 >= Range("$b$6").Value Then
Range("$b$6").Value = Range("$b$5").Value + 1
End If

If Target.Address = "$B$6" And Range("$b$6").Value - 1 <= Range("$b$5").Value Then
Range("$b$5").Value = Range("$b$6").Value - 1
End If

Application.ScreenUpdating = True
End Sub

B5 - это ячейка, содержащая дату прибытия, b6 - этоячейка, содержащая дату отъезда.При срабатывании этот макрос должен проверять, какая ячейка была изменена (b5 или b6) и есть ли arr.дата равна или выше, чем деп.Дата.И если это так, автоматически измените другую ячейку (ту, которая не была изменена вручную).

Теперь, когда я опускаю второй оператор if, он работает просто отлично.Если я опущу второе выражение if, оно также будет работать нормально.Когда оба оператора активны, он вызывает ошибки каждый раз.Я получаю сообщение «Недостаточно места в стеке» (перевод с голландского).

Я также пробовал этот код, используя регистр: 

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False

If Range("b6").Value - 1 <= Range("b5").Value Then

Select Case Target.Address(0, 0)
   Case "b5": Range("vertrek").Value = Range("aankomst").Value + 1
   Case "b6": Range("aankomst").Value = Range("vertrek").Value - 1
End Select

End If

Application.ScreenUpdating = True
End Sub

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

Кто-нибудь знает, где находится моя ошибка, или кто-то знаетдругого метода для достижения моей цели?

1 Ответ

0 голосов
/ 08 июня 2018

Защита от повторного поднятия одного и того же события снова и снова: 

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.EnableEvents = False

    If Target.Address = "$B$5" And Range("$b$5").Value + 1 >= Range("$b$6").Value Then
        Range("$b$6").Value = Range("$b$5").Value + 1
    End If

    If Target.Address = "$B$6" And Range("$b$6").Value - 1 <= Range("$b$5").Value Then
        Range("$b$5").Value = Range("$b$6").Value - 1
    End If

Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
...