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

以下VBA代码应能达到您想要的结果：

visibility: hidden ;

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

我建议结合使用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

进行更改后自动更新工作表-VBA Excel

4 个答案: