Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 30.03.2017, 01:35   #11
varikvn
Пользователь
 
Регистрация: 27.01.2017
Сообщений: 21
По умолчанию

Проверил этот вариант:
Код:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim col As Long: col = Target.Column
    If Target.Count > 1 Then Exit Sub
    If Intersect(Range("H17:T18,H72:T73"), Target) Is Nothing Then Exit Sub
    If Cells(17, col) <> "" And Cells(18, col) <> "" And _
        Cells(72, col) <> "" And Cells(73, col) <> "" Then
        Cells(74, col) = Date
    End If
End Sub
Первый Ваш вариант лучше, т.к. он очищал поле ДАТА если происходили изменения, а этот вариант не очищает.
varikvn вне форума Ответить с цитированием
Старый 30.03.2017, 09:23   #12
AlexM12
Форумчанин
 
Аватар для AlexM12
 
Регистрация: 29.08.2012
Сообщений: 209
По умолчанию

Код который вы добавили в сообщение №8 работать не должен.
Worksheet_Change - это не название макроса, а имя события, которое запускает макрос, если в ячейках листа произошло изменение.
Если имя поменять, работать не будет. Если два макроса с одним именем, работать не будет.
Проверяйте. Вернул очистку.
Код:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim col As Long: col = Target.Column
    If Target.Count > 1 Then Exit Sub
    If Intersect(Range("H17:T18,H72:T73,H76:T77"), Target) Is Nothing Then Exit Sub
    If Cells(17, col) <> "" And Cells(18, col) <> "" And _
        Cells(72, col) <> "" And Cells(73, col) <> "" Then
        Cells(74, col) = Date
    Else
        Cells(74, col) = ""
    End If
    If Cells(17, col) <> "" And Cells(18, col) <> "" And _
        Cells(76, col) <> "" And Cells(77, col) <> "" Then
        Cells(75, col) = Date
    Else
        Cells(75, col) = ""
    End If
End Sub
В файле 03 добавил Application.EnableEvents и Application.ScreenUpdating (отключение событий и обновление экрана), будет чуть быстрее работать
Вложения
Тип файла: rar Журнал_1_02.rar (56.5 Кб, 20 просмотров)
Тип файла: rar Журнал_1_03.rar (58.8 Кб, 22 просмотров)
Алексей М.

Последний раз редактировалось AlexM12; 30.03.2017 в 09:34.
AlexM12 вне форума Ответить с цитированием
Старый 31.03.2017, 03:48   #13
varikvn
Пользователь
 
Регистрация: 27.01.2017
Сообщений: 21
По умолчанию

Проверил, все работает на ура! Спасибо!
varikvn вне форума Ответить с цитированием
Старый 28.08.2017, 18:49   #14
varikvn
Пользователь
 
Регистрация: 27.01.2017
Сообщений: 21
По умолчанию

AlexM12, здравствуйте!

Очень прошу помощи - Вам макрос работает, но мне его нужно модернизировать, что бы я защитил лист от редактирования, а макрос в защищенную ячейку мог записать эти данные, а человек не мог.
это описано в статье: Как защитить лист от пользователя, но не от макроса?

Я так понимаю, мне нужно Ваш макрос:
Код:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim col As Long: col = Target.Column
    If Target.Count > 1 Then Exit Sub
    If Intersect(Range("P8:SZ9,P63:SZ64,P67:SZ68"), Target) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    If Cells(8, col) <> "" And Cells(9, col) <> "" And _
        Cells(63, col) <> "" And Cells(64, col) <> "" Then
        Cells(65, col) = Date
    Else
        Cells(65, col) = ""
    End If
    If Cells(8, col) <> "" And Cells(9, col) <> "" And _
        Cells(67, col) <> "" And Cells(68, col) <> "" Then
        Cells(66, col) = Date
    Else
        Cells(66, col) = ""
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
Объединить с макросом из статьи:

Код:
Sub Protect_for_User_Non_for_VBA()
 ActiveSheet.Protect Password:="1111", UserInterfaceOnly:=True
End Sub
У меня увы, не вышло ((

Если кто поможет, буду очень благодарен!
varikvn вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
АВТОМАТИЧЕСКАЯ ВСТАВКА ДАННЫХ Айвенго Microsoft Office Access 24 15.03.2012 13:28
Проблема с взаимодействием динамической и статической памяти - обращение к статической переменной Comst95 Паскаль, Turbo Pascal, PascalABC.NET 1 03.01.2012 18:46
Автоматическая вставка нужного текста ogololobov2009 Microsoft Office Excel 1 16.03.2011 17:59
автоматическая вставка даты в нужном падеже mistx Microsoft Office Excel 14 06.11.2009 17:47
В развитие темы автоматическая вставка даты в нужном падеже ХочуЗнать Microsoft Office Excel 5 06.11.2009 16:15