Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
Проверка на заполнение ячеек в строке
 
Проблема была как сделать так, чтобы заставить пользователя обязательно внести информацию в нужные ячейки при заполнении. Например, если ячейка А2 непустая, то запретить пользователю переход на другую строку (запрет выделения ячеек на других строках), если ячейки D2 и G2 пустые. А ячейку A2 запретить изменять, если пустая ячейка A1. Соответственно, тот же случай с ячейками А3 и D3,G3 и т.д.  
 
За основу взял несколько примеров все глючили  - вот один поправил вроде работает  
Получилось выделить исходный диапазон – проверил ошибок не выдает  
 
Осталось сделать подсветку незаполненных ячеек в строке  вместо  MsgBox  + если не заполнены ячейки хотя бы в одной строке – не дает переходить с листа на лист и закрыть файл – вылазит  табличка "Полностью Заполните поля строки !"  
Пока не знаю как реализовать- кто поможет HELP    
 
Файлик прилагаю.  
 
 
Код  
 
Private Sub Worksheet_Change(ByVal Target As Range)  
flag = 0  
If Target.Column >= 2 And Target.Column <= 7 And Target.Row > 8 And Target.Row <= 701 Then ‘ вводим диапазон где будет проверка  
For j = 2 To 7 Step 1  
If Cells(Target.Row - 1, j) = "" Then  
flag = 1  
End If  
Next j  
If flag = 1 Then  
Application.EnableEvents = False  
Target.Value = ""  
Application.EnableEvents = True  
MsgBox ("Заполните всю информацию по дате")  
End If  
End If  
End Sub
Выпадающий календарь - доработать под задачу
 
Есть очень хороший выпадающий календарь  - хотелось бы его доработать под следующую задачу:  
Календарь вводит дату и время в одну ячейку  а надо чтоб вводил дату в одну ячейку а время во 2 ячейку справа   - как в примере (прилагаю файл)      
Например Дата в G:11 Время H:11   -   Дата в G:12 Время H:12    и тд  
 
При этом ввод времени в форме календаря переделать в виде выпадающего списка (поля и кнопки установки времени убрать) – для времени остается одно поле с выпадающим списком  
Выпадающий список взять с листа «Время» в приложенном файле.  
 
Календарь нужно привязать к вводу только в диапазон G10:H500  
Причем в столбец G вводим дату,  в столбец H – время  
 
Впоследствие путем сортировки на даты – а потом сортировки на время внутри даты  получается план на день с утра
Добавление новых строк на 2 листах по условиям
 
Как одновременно добавить 2 строки в последнюю в 2 листа книги по кнопке макроса Условия такие:  
1. Доп строки добавляются только в листы книги  «Список» и «Мероприятия»  
2. Ячейки листов «Список» и «Мероприятия» связаны ссылками по условиям =Список!C5 и тд на листе «Мероприятия»  
3. В дополнительной созданной строке на листах  сохраняется форматирование  
предыдущей строки    
4. В дополнительной созданной ячейке в столбце № листа «Список»появляется следующий порядковый номер( те +1), в остальных  ячейках  новой строки дб пусто ( с сохранением форматирования)  
5. В дополнительной созданной строке на листе  «Мероприятия» сохраняется форматирование и формулы предыдущей строки    
6. Кнопка макроса на листе «Список» - по ее нажатию выскакивает  окно формы  
с надписью « Заполните название предприятия» - ОК – запись попадает в новую строку ( если предприятие не заполнено то ОК не срабатывает)
Как скрыть пустые строки с "0" значением
 
Есть в таблице пустые строки с "0" значением тк введены формулы  и просто пустые    
Как их скрыть  
 
 
Пример в файле
Условное форматирование с помощью управляющего листа
 
Реализовано условное форматирование с помощью управляющего листа  
но только цвета ячеек  
 
Как добавить форматирование шрифта (цвет, толщину) ?  
 
Private Sub Worksheet_Change(ByVal Target As Range)  
   If Target.Column <> 1 Then Exit Sub  
   If Target.Count > 1 Then Exit Sub  
   If Target = "" Then  
       Target.Interior.ColorIndex = xlNone: Exit Sub  
   End If  
   Dim x As Range, s As String  
   s = Application.Trim(Replace(Split(Target, "-")(0), "", ""))  
   Set x = Sheets(2).[A:A].Find(Split(s, " ")(0))
   If x Is Nothing Then Exit Sub  
   If x.Interior.ColorIndex <> xlNone Then Target.Interior.ColorIndex = x.Interior.ColorIndex  
     
End Sub  
 
 
файл прилагаю
Копирование строки формул при добавлении текста в ячейку
 
Работает макрос так  
Ячейка С11 (только текстовые данные)заполнена напротив в ячейках G11 H11 I11 находятся образцы формул  
Ввожу текст в ячейку С12 - формулы появляются в ячейках G12 H12 I12;  
Ввожу текст в ячейку С13 - формулы появляются в ячейках G13 H13 I13;  
и тд  
Если стер текст ( из ячейки допустим С13) - формулы в ячейках G13 H13 I13 убираются  
Если стер формулы из ячеек G13 H13 I13 то при вводе нового текста в ячейку С13 формулы вновь работают  
Ввод формул работает при наборе текста а не числовых значений (как условие)  
Сделано для того чтоб не плодить в большом массиве данных формулы (иначе тормозит таблица при пересчете ячеек) а добавлять формулы в требуемые ячейки при появлении исх данных  
 
 
Проблема следующая:  
Если текст в исх ячейках С11 С12 С13 и тд появляются не ручным вводом текста а по формуле ссылки - я путем "перетаскиванием" формулы по столбцу ввожу ссылки в нижние ячейки столбца С  
(ТО ЕСТЬ ЗАНОШУ ЗНАЧЕНИЯ СРАЗУ ОДНОВРЕМЕННО В НЕСКОЛЬКО ЯЧЕЕК СТОЛЦА) то то пересчет формул не ведется  
 
Пересчет ведется когда только по одной дополн записи в колонку С добавляешь  
 
Посоветовали в код макроса добавить принудительный пересчет формул:  
Else  
Application.Volatile  
If  
или    
Else  
ActiveSheet.Calculate    
If  
но данный вариант чегото не сработал  
 
 
Код:  
 
 
Private Sub Worksheet_Change(ByVal Target As Range)  
On Error Resume Next  
If Target.Row = 11 Then Exit Sub 'строка начала диапазона текста(задаем диапазон текста)  
If Target.Column = 3 Then ' столбец начала диапазона текста(задаем диапазон текста)  
Debug.Print Target.Value  
Range(Cells(Target.Row, 7), Cells(Target.Row, 9)) _  
= [g11:i11].Formula ' диапазон столбцов+диапазон исх ячеек с формулами
If Target.Value = "" Then Range(Cells(Target.Row, 7), Cells(Target.Row, 9)).ClearContents 'условие на стирание  
If IsNumeric(Target.Value) Then Range(Cells(Target.Row, 7), Cells(Target.Row, 9)).ClearContents 'условие на стирание  
End If  
End Sub  
 
Как это можно поправить ?  
 
Файл прилагаю
Страницы: 1
Наверх