Здравствуйте мои многолетние учителя . Помогите сократить время по заполнению столбцов входа и выхода . Можно ли сделать так что бы я вводила в ячейки только время , а сегодняшняя дата вводилась автоматически ? И еще одна модернизация(если нужно то создам другую тему)-можно ли сделать так что бы при заполнении строчки у Иванова или Петрова под ней создавалась пустая строчка(что бы не резервировать под каждого работника 31 строчку ).Заранее благодарю.
Здравствуйте мои многолетние учителя . Помогите сократить время по заполнению столбцов входа и выхода . Можно ли сделать так что бы я вводила в ячейки только время , а сегодняшняя дата вводилась автоматически ? И еще одна модернизация(если нужно то создам другую тему)-можно ли сделать так что бы при заполнении строчки у Иванова или Петрова под ней создавалась пустая строчка(что бы не резервировать под каждого работника 31 строчку ).Заранее благодарю.12345tn
Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False 'отключение отслеживания событий a = Cells(Rows.Count, "b").End(xlUp).Row 'нижняя заполненная ячейка столбца B If Not Intersect(Target, Range("b2:c" & a)) Is Nothing Then 'изменение ячеек в B и C If Target.Count > 1 Then 'если изменяется > 1 ячейки: Application.EnableEvents = True 'включаем отслеживания событий Exit Sub 'прекращаем работу макроса End If b = Target.Value 'значение вводимое в ячейку On Error Resume Next 'если ошибка, идем дальше c = "" 'при ошибке целое = пустоте* c = Int(b) 'целое от значения (если только время, = 0) If c = 0 Then d = Target.Row 'строка, в которую вводиться значение e = Target.Column 'столбец, в который вводиться значение If e = 2 Then 'если это столбец B (2) Rows(d).Insert 'добавляем строку Target.Offset(-1, 0) = Date + b 'в строку выше сегодня + введенное время Target.ClearContents 'очищаем строку со временем Else 'иначе - столбец C Target = Date + b 'в ячейке с введенным временем добавляем сегодня End If End If End If Application.EnableEvents = True 'включаем отслеживания событий End Sub
[/vba]
12345tn, так хотели? [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False 'отключение отслеживания событий a = Cells(Rows.Count, "b").End(xlUp).Row 'нижняя заполненная ячейка столбца B If Not Intersect(Target, Range("b2:c" & a)) Is Nothing Then 'изменение ячеек в B и C If Target.Count > 1 Then 'если изменяется > 1 ячейки: Application.EnableEvents = True 'включаем отслеживания событий Exit Sub 'прекращаем работу макроса End If b = Target.Value 'значение вводимое в ячейку On Error Resume Next 'если ошибка, идем дальше c = "" 'при ошибке целое = пустоте* c = Int(b) 'целое от значения (если только время, = 0) If c = 0 Then d = Target.Row 'строка, в которую вводиться значение e = Target.Column 'столбец, в который вводиться значение If e = 2 Then 'если это столбец B (2) Rows(d).Insert 'добавляем строку Target.Offset(-1, 0) = Date + b 'в строку выше сегодня + введенное время Target.ClearContents 'очищаем строку со временем Else 'иначе - столбец C Target = Date + b 'в ячейке с введенным временем добавляем сегодня End If End If End If Application.EnableEvents = True 'включаем отслеживания событий End Sub
12345tn, Доброго времени суток. Ещё как вариант вам. Внесите следуйщий код в модуль листа Лист1. [vba]
Код
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Application.EnableEvents = False
If Target.Count > 1 Then Application.EnableEvents = True Exit Sub End If
If Target.Column = 2 Or Target.Column = 3 Then Target.Value = Format(Now, "dd.mm.yyyy hh:mm:ss") End If
Application.EnableEvents = True End Sub
Private Sub Worksheet_Change(ByVal Target As Range) Application.ScreenUpdating = False
If Target.Column = 2 Or Target.Column = 3 Then
' Копируем форматы и формулу из текущей строки (колонки A-D) в новую строку (ниже) If Cells(Target.Row, 2) <> "" And Cells(Target.Row, 3) <> "" Then Rows(Target.Row + 1).Insert Shift:=xlDown Rows(Target.Row).Copy Destination:=Rows(Target.Row + 1)
With Range(Cells(Target.Row + 1, 1), Cells(Target.Row + 1, 3)) .ClearContents .Borders(xlEdgeTop).LineStyle = xlNone .Borders(xlEdgeBottom).LineStyle = xlContinuous End With
End If
End If
Application.ScreenUpdating = True End Sub
[/vba] Удачи.
12345tn, Доброго времени суток. Ещё как вариант вам. Внесите следуйщий код в модуль листа Лист1. [vba]
Код
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Application.EnableEvents = False
If Target.Count > 1 Then Application.EnableEvents = True Exit Sub End If
If Target.Column = 2 Or Target.Column = 3 Then Target.Value = Format(Now, "dd.mm.yyyy hh:mm:ss") End If
Application.EnableEvents = True End Sub
Private Sub Worksheet_Change(ByVal Target As Range) Application.ScreenUpdating = False
If Target.Column = 2 Or Target.Column = 3 Then
' Копируем форматы и формулу из текущей строки (колонки A-D) в новую строку (ниже) If Cells(Target.Row, 2) <> "" And Cells(Target.Row, 3) <> "" Then Rows(Target.Row + 1).Insert Shift:=xlDown Rows(Target.Row).Copy Destination:=Rows(Target.Row + 1)
With Range(Cells(Target.Row + 1, 1), Cells(Target.Row + 1, 3)) .ClearContents .Borders(xlEdgeTop).LineStyle = xlNone .Borders(xlEdgeBottom).LineStyle = xlContinuous End With
12345tn, Вот это поворот... Ловите файл. Двойной щелчок по ячейки куда вам надо вставить время и после нажимаете на Ентер. Вот и все ваши действия.
12345tn, Вот это поворот... Ловите файл. Двойной щелчок по ячейки куда вам надо вставить время и после нажимаете на Ентер. Вот и все ваши действия.MikeVol
Не знаю у кого как, но у меня при нажатии одновременно трех клавиш Shift+Ctrl+4 вставляется текущая дата, при нажатии Shift+Ctrl+6 вставляется текущее время. Клавишу Плюс не нажимать.
Не знаю у кого как, но у меня при нажатии одновременно трех клавиш Shift+Ctrl+4 вставляется текущая дата, при нажатии Shift+Ctrl+6 вставляется текущее время. Клавишу Плюс не нажимать.gling
ЯД-41001506838083
Сообщение отредактировал gling - Среда, 18.10.2023, 23:07