Страницы: 1
RSS
Обьединение 2-х макросов в рамках одной процедуры "Worksheet_Change"
 
Всем привет.

Прошу помощи. Только начал разбираться в макросами, поэтому не знаю как сделать.

Задача: необходимо проставлять даты изменений в двух ячейках на одном листе. Есть одинаковые макросы (ниже), но с различными адресами ячеек. Понимаю что нужно сделать все в рамках одной процедуры "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 

Заранее спасибо за помощь

С Уважением, Алексей.
Изменено: a.m.v. - 20.07.2019 10:21:55
 
Ламеру бы правила форума сперва почитать.
По вопросам из тем форума, личку не читаю.
 
a.m.v., код следует оформлять соответствующим тегом: ищите такую кнопку (см. скрин) и исправьте своё сообщение.
 
замените на такие 2:
Код
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
Изменено: Ігор Гончаренко - 20.07.2019 00:53:35
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Всем привет.

Спасибо за указания. Поправил. Отдельное человеческое спасибо Ігор Гончаренко за помощь. Все получилось.
В качестве развития. А каким образом возможно для одной ячейки указывать формат даты со временем, а для другой - только дату.?
Формат ячеек естественно не работает.

Заранее спасибо за ответ.

С Уважением, Алексей.
 
обьявите 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"
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Цитата
Ігор Гончаренко написал:
, "dd.mm.yyyy"
КРУУУТЬ ! Ігор Гончаренко СПАСИБО !

У меня последний вопрос, если есть возможность помочь в некоторой оптимизации процесса. Есть несколько столбцов в таблице на этом же листе для которой действует созданный Вами макрос (файл прилагается).

Логика такая: если в столбце "Осталось" сумма меньше или равна 0, автоматически (с помощью нового макроса) в столбце "Статус" проставляется значение "Won", несмотря на то что другие статусы указывает человек при других условиях с помощью выпадающего списка.

И вот этот макрос надо как то запихнуть в уже действующий макрос с датами.

Заранее спасибо за любой ответ.

С Уважением, Алексей.
 
vikttur, думаю что можно продолжить и в этой теме, т.к.
Цитата
a.m.v. написал: И вот этот макрос надо как то запихнуть в уже действующий макрос с датами.
a.m.v., можно как-то так так,
Код
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,
макросы задают форматы (не факт что меняют) в некоторых ячейках колонок правее В и левее Х (не В и Х, а С и W)
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Цитата
Ігор Гончаренко написал: правее В
Да, описАлся, в столбце 'C' конечно, но  смысл вопроса остается тем же
Согласие есть продукт при полном непротивлении сторон
 
Цитата
Sanja написал: Да, описАлся, в столбце 'C' конечно, но  смысл вопроса остается тем же
Sanja и Ігор Гончаренко, спасибо за коментарии. Это конечно мне не нужно. Возможно я некорректно пояснил Вам формат таблицы, которой сейчас пытаюсь привести в нормальный вид. Поэтому прилагаю для Вашего понимания. В заголовках присутствуют мои примечания, что я в итоге хотел бы получить. Попытался макрос Sanja привести в соответствие с приложенной таблицей, но что то не получилось :(

Если реально оптимизировать макрос с автоматическим указанием статуса "Won" не получится или решение будет слишком замороченным,  я готов вернусь к варианту Ігор Гончаренко,

Я Вас снова благодарю за оказанную помощь.

С Уважением, Алексей.
Изменено: a.m.v. - 20.07.2019 17:23:52
 
?
Согласие есть продукт при полном непротивлении сторон
 
Sanja, чуть подправил, чтобы даты появлялись там где нужно. Но не могу понять, как сделать так чтобы статус "Won" появлялся не в столбце "P", а в столбце "R"  
 
При изменении ячеек какого столбца должно появляться 'Won' в столбце 'R'?
Согласие есть продукт при полном непротивлении сторон
 
Цитата
Sanja написал:
При изменении ячеек какого столбца должно появляться 'Won' в столбце 'R'?
В столбце "Q" (наименование "Осталось") рассчитывается разница между значениями в столбцах "O" (наименование "Сумма")и "P" (наименование "Получено"). Статус "Won" должен появится в столбце "R" (наименование "Статус") при условии если значение в столбце "Q" меньше или равно нулю.
 
См.файл
Согласие есть продукт при полном непротивлении сторон
 
Sanja, нет слов, кроме слов благодарности. То что нужно. ОГРОМНОЕ СПАСИБО !

С Уважением, Алексей.
 
Пожалуйста :)  
Согласие есть продукт при полном непротивлении сторон
Страницы: 1
Наверх