Прошу помощи. Только начал разбираться в макросами, поэтому не знаю как сделать.
Задача: необходимо проставлять даты изменений в двух ячейках на одном листе. Есть одинаковые макросы (ниже), но с различными адресами ячеек. Понимаю что нужно сделать все в рамках одной процедуры "Worksheet_Change". Но как правильно объединить - так и не осилил.
Макрос №1
Код
Private Sub Worksheet_Change(ByVal Target As Range)'Update 20140722
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("X:X"), Target)
xOffsetColumn = -1
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
For Each Rng In WorkRng
If Not VBA.IsEmpty(Rng.Value) Then
Rng.Offset(0, xOffsetColumn).Value = Now
Rng.Offset(0, xOffsetColumn).NumberFormat = "dd.mm.yyyy, hh:mm"
Else
Rng.Offset(0, xOffsetColumn).ClearContents
End If
Next
Application.EnableEvents = True
End If
End Sub
Макрос №2
Код
Private Sub Worksheet_Change(ByVal Target As Range)'Update 20140722
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("B:B"), Target)
xOffsetColumn = 1
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
For Each Rng In WorkRng
If Not VBA.IsEmpty(Rng.Value) Then
Rng.Offset(0, xOffsetColumn).Value = Now
Rng.Offset(0, xOffsetColumn).NumberFormat = "dd.mm.yyyy, hh:mm"
Else
Rng.Offset(0, xOffsetColumn).ClearContents
End If
Next
Application.EnableEvents = True
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
InsData Intersect(Application.ActiveSheet.Range("X:X"), Target), -1
InsData Intersect(Application.ActiveSheet.Range("B:B"), Target), 1
End Sub
Sub InsData(InpRg As Range, offs As Integer)
Dim Rng As Range
If InpRg Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each Rng In InpRg
If Not VBA.IsEmpty(Rng.Value) Then
Rng.Offset(0, offs).Value = Now
Rng.Offset(0, offs).NumberFormat = "dd.mm.yyyy, hh:mm"
Else
Rng.Offset(0, offs).ClearContents
End If
Next
Application.EnableEvents = True
End Sub
Спасибо за указания. Поправил. Отдельное человеческое спасибо Ігор Гончаренко за помощь. Все получилось. В качестве развития. А каким образом возможно для одной ячейки указывать формат даты со временем, а для другой - только дату.? Формат ячеек естественно не работает.
обьявите Sub InsData с 3-мя параметрами Sub InsData(InpRg As Range, offs As Integer, Optional DateFormat$ = "dd.mm.yyyy, hh:mm") строку в ней Rng.Offset(0, offs).NumberFormat = "dd.mm.yyyy, hh:mm" замените на Rng.Offset(0, offs).NumberFormat = DateFormat вызывайте InsData там, где это нужно, с 3-им параметром: InsData Intersect(Application.ActiveSheet.Range("B:B"), Target), 1, "dd.mm.yyyy" иди InsData Intersect(Application.ActiveSheet.Range("X:X"), Target), -1, "dd.mm.yyyy"
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
У меня последний вопрос, если есть возможность помочь в некоторой оптимизации процесса. Есть несколько столбцов в таблице на этом же листе для которой действует созданный Вами макрос (файл прилагается).
Логика такая: если в столбце "Осталось" сумма меньше или равна 0, автоматически (с помощью нового макроса) в столбце "Статус" проставляется значение "Won", несмотря на то что другие статусы указывает человек при других условиях с помощью выпадающего списка.
И вот этот макрос надо как то запихнуть в уже действующий макрос с датами.
Private Sub Worksheet_Change(ByVal Target As Range)
lRow = Cells(Rows.Count, "A").End(xlUp).Row
If Not Intersect(Target, Range("A2:B" & lRow)) Is Nothing And Target.Count = 1 Then
Application.ScreenUpdating = False
Application.EnableEvents = False
iOff = IIf(Target.Column = 1, 2, 1)
If Target.Offset(, iOff) <= 0 Then Target.Offset.Value = "Won"
End If
InsData Intersect(Range("X:X"), Target), -1
InsData Intersect(Range("B:B"), Target), 1
Application.EnableEvents = True
Application.EnableEvents = True
End Sub
Private Sub InsData(InpRg As Range, offs As Integer)
Dim Rng As Range
If InpRg Is Nothing Then Exit Sub
For Each Rng In InpRg
If Not VBA.IsEmpty(Rng.Value) Then
Rng.Offset(0, offs).Value = Now
Rng.Offset(0, offs).NumberFormat = "dd.mm.yyyy, hh:mm"
Else
Rng.Offset(0, offs).ClearContents
End If
Next
End Sub
НО! макросы от Ігор Гончаренко, меняют форматы ячеек в т.ч. в столбце 'B' (Осталось). Вам точно ЭТО надо? Что бы в столбце 'B' разница была отформатирована как дата?
Согласие есть продукт при полном непротивлении сторон
Sanja написал: Да, описАлся, в столбце 'C' конечно, но смысл вопроса остается тем же
Sanja и Ігор Гончаренко, спасибо за коментарии. Это конечно мне не нужно. Возможно я некорректно пояснил Вам формат таблицы, которой сейчас пытаюсь привести в нормальный вид. Поэтому прилагаю для Вашего понимания. В заголовках присутствуют мои примечания, что я в итоге хотел бы получить. Попытался макрос Sanja привести в соответствие с приложенной таблицей, но что то не получилось
Если реально оптимизировать макрос с автоматическим указанием статуса "Won" не получится или решение будет слишком замороченным, я готов вернусь к варианту Ігор Гончаренко,
Sanja, чуть подправил, чтобы даты появлялись там где нужно. Но не могу понять, как сделать так чтобы статус "Won" появлялся не в столбце "P", а в столбце "R"
Sanja написал: При изменении ячеек какого столбца должно появляться 'Won' в столбце 'R'?
В столбце "Q" (наименование "Осталось") рассчитывается разница между значениями в столбцах "O" (наименование "Сумма")и "P" (наименование "Получено"). Статус "Won" должен появится в столбце "R" (наименование "Статус") при условии если значение в столбце "Q" меньше или равно нулю.