У меня такая проблема. В этой теме добрые люди мне помогли сделать один VBA скриптик.
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Not Intersect(Target, Range("A1:G13")) Is Nothing Then Application.EnableEvents = False If Target.Value <> "" And Target.Value <> "x" And Not IsDate(Target.Value) Then MsgBox "Only 'DATE' or 'X' value are allowed to input!", vbCritical Target.ClearContents Else Target = Format(Target, "dd.mm.yyyy") End If Application.EnableEvents = True Range("A1:G13").HorizontalAlignment = xlRight End If End Sub
[/vba] Обнаружил, что с данным макросом перестаёт работать условное форматирование (conditional formatting).
Хотел сделать такое правило:
Т.е. если событие было больше, чем год назад, система должна выделять её красным цветом. Но этого не происходит. Причём текст вводится красным цветом, а потом резко превращается в чёрный.
Без макроса эта функция у меня работает без проблем.
Может кто-то смог бы помочь разобраться?
Здравствуйте,
У меня такая проблема. В этой теме добрые люди мне помогли сделать один VBA скриптик.
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Not Intersect(Target, Range("A1:G13")) Is Nothing Then Application.EnableEvents = False If Target.Value <> "" And Target.Value <> "x" And Not IsDate(Target.Value) Then MsgBox "Only 'DATE' or 'X' value are allowed to input!", vbCritical Target.ClearContents Else Target = Format(Target, "dd.mm.yyyy") End If Application.EnableEvents = True Range("A1:G13").HorizontalAlignment = xlRight End If End Sub
[/vba] Обнаружил, что с данным макросом перестаёт работать условное форматирование (conditional formatting).
Хотел сделать такое правило:
Т.е. если событие было больше, чем год назад, система должна выделять её красным цветом. Но этого не происходит. Причём текст вводится красным цветом, а потом резко превращается в чёрный.
Без макроса эта функция у меня работает без проблем.
KIMVSR, а зачем Вы при каждом изменении любой ячейки из диапазона A1:G13 снова и снова устанавливаете формат ячеек всего диапазона? Это достаточно сделать всего один раз, и можно руками. (см. вложенный файл)
а чтобы не дублировать одни и те же проверки, проще так:[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Not Intersect(Target, Range("A1:G13")) Is Nothing Then If Target.Value <> "" And Target.Value <> "x" Then Application.EnableEvents = False If IsDate(Target.Value) Then 'Target = Format(Target, "dd.mm.yyyy") ' так в ячейку будет помещена дата в текстовом формате, поэтому у вас УФ и не срабатывало Target = CDate(Replace(Target, ",", ".")) ' чтобы была честная дата, а не текст (как я Вам сразу и предлагал) 'Target.HorizontalAlignment = xlRight ' это не понадобится, если применить формат ячеек, который я предлагал Вам ранее (см. формат ячеек) Else MsgBox "Only date or 'x' value is allowed to input!", vbCritical Target.ClearContents Target.Select End If Application.EnableEvents = True End If End If End Sub
KIMVSR, а зачем Вы при каждом изменении любой ячейки из диапазона A1:G13 снова и снова устанавливаете формат ячеек всего диапазона? Это достаточно сделать всего один раз, и можно руками. (см. вложенный файл)
а чтобы не дублировать одни и те же проверки, проще так:[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Not Intersect(Target, Range("A1:G13")) Is Nothing Then If Target.Value <> "" And Target.Value <> "x" Then Application.EnableEvents = False If IsDate(Target.Value) Then 'Target = Format(Target, "dd.mm.yyyy") ' так в ячейку будет помещена дата в текстовом формате, поэтому у вас УФ и не срабатывало Target = CDate(Replace(Target, ",", ".")) ' чтобы была честная дата, а не текст (как я Вам сразу и предлагал) 'Target.HorizontalAlignment = xlRight ' это не понадобится, если применить формат ячеек, который я предлагал Вам ранее (см. формат ячеек) Else MsgBox "Only date or 'x' value is allowed to input!", vbCritical Target.ClearContents Target.Select End If Application.EnableEvents = True End If End If End Sub