Обновление листа автоматически при внесении изменений - VBA Excel

Question

Я изо всех сил пытался выработать логику для этого, поэтому любая помощь будет оценена!

У меня есть лист с именами и датами, в каждой строке (в столбце примера от D до F) ему нужно найти наибольшую дату, а затем добавить дату в столбец (столбец C). Я могу заставить это работать на одной тестовой строке, но мне нужно, чтобы это работало, когда есть изменение в любой строке.

  B           C            D           E           F
Name       Due Date      Date 1      Date 2      Date 3

Dave       01-01-20     01-01-14    01-01-17   
Sarah      01-01-21     01-02-11    01-02-15    01-02-18 

Код, который у меня есть на данный момент:

LastRow = wsCB.Cells(Rows.Count, "C").End(xlUp).Row
rowcount = 12

Max_date = Application.WorksheetFunction.Max(wsCB.Range(wsCB.Cells(rowcount, 5), wsCB.Cells(rowcount, 10)))

Max_date = CDate(Max_date)

DueDate = DateAdd("yyyy", 3, Max_date)

wsCB.Cells(12, 4) = DueDate

Я настроил его на вызов Worksheet_Change. Я пробовал разные циклы, пытаясь использовать xlup, но я не уверен, что это правильный путь, так как мне нужно обновить значение, когда пользователь ввел новую дату для кого-то. Я не могу понять, как масштабировать этот однострочный пример на весь лист.

Данные не будут массивными, однако таких листов будет 5, и на каждом листе может быть не более 70 имен.

Я все еще новичок в VBA, поэтому любой совет будет очень полезен!

Answer 1

Я предлагаю использовать Intersect в сочетании с циклом в диапазоне Target, чтобы вы немного сэкономили на вставке целого диапазона значений.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet
    Set ws = Target.Parent

    If Not Intersect(Target, ws.Range("D:F")) Is Nothing Then
        Dim MaxDate As Double
        Dim DueDate As Variant

        Dim iRow As Long
        For iRow = Target.Row To Target.Row + Target.Rows.Count - 1
            On Error Resume Next
            MaxDate = Application.WorksheetFunction.Max(ws.Range(ws.Cells(iRow, "D"), ws.Cells(iRow, "F")))
            If Err.Number <> 0 Then
                DueDate = "#VALUE!"
            ElseIf MaxDate = 0 Then
                DueDate = vbNullString 'remove date if no dates
            Else
                DueDate = DateAdd("yyyy", 3, MaxDate)
            End If
            On Error GoTo 0

            Application.EnableEvents = False 'prevents triggering change event again

            ws.Cells(iRow, "C").Value = DueDate

            Application.EnableEvents = True
        Next iRow
    End If
End Sub

Answer 2

Попробуй это.
Вам просто нужно настроить столбцы в соответствии с вашими потребностями

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim MaxDate As Date, DueDate As Date
    Dim CurRow As Long
    Dim Ws As Worksheet

    Set Ws = Target.Parent
    CurRow = Target.Row

    With Ws
        MaxDate = CDate(Application.WorksheetFunction.Max(.Range(.Cells(CurRow, "D"),.Cells(CurRow, "F"))))
        DueDate = DateAdd("yyyy", 3, MaxDate)
        Application.EnableEvents = False
        .Cells(CurRow, 3) = DueDate
        Application.EnableEvents = True
    End With

End Sub

Answer 3

Мой код для вашей проблемы:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim xCellColumnD As Long
Dim xCellColumnE As Long
Dim xCellColumnF As Long
Dim xDueColumn As Long
Dim xRow As Long, xCol As Long


xCellColumnD = 4
xCellColumnE = 5
xCellColumnF = 6
xDueColumn = 3

xRow = Target.Row
xCol = Target.Column

If Target.Text <> "" Then
    If xCol = xCellColumnD Or xCol = xCellColumnE Or xCol = xCellColumnF Then
        Max_date = Application.WorksheetFunction.Max(Range(Cells(xRow, 4), Cells(xRow, 6)))
        Max_date = CDate(Max_date)
        DueDate = DateAdd("yyyy", 3, Max_date)
        Cells(xRow, xDueColumn) = DueDate
    End If
End If

End Sub

Answer 4

Следующий код VBA должен достичь желаемых результатов:

Private Sub Worksheet_Change(ByVal Target As Range)
Select Case Target.Column
    Case 4, 5, 6 'if user entered data in columns D to F
    Max_date = Application.WorksheetFunction.Max(Range(Cells(Target.Row, 4), Cells(Target.Row, 6)))
    'get the max value in row from column D to F (4 to 6)
    Max_date = CDate(Max_date)

    DueDate = DateAdd("yyyy", 3, Max_date)

    Cells(Target.Row, 3) = DueDate
End Select
End Sub