在工作表

Question

我正在尝试编写一个宏来识别列中的最后一个时间戳，添加一个已定义的天数并更新数据集中每列的截止日期，直到它到达空白列。

这是我希望运行计算的数据集的屏幕截图：

对于其他计算，我使用ActiveCell.Offset导航我的电子表格并运行计算，但在这种情况下使用它会变得非常混乱。

现有计算的代码示例：

ws.Range("B74").Select
Do Until ActiveCell.Offset(0, 1).Value = ""
ActiveCell.Offset(-23, 1).Formula = "=Round(((R[-2]C[0]+R[-4]C[0])/R[-14]C[0])*100,2)"
    If IsError(ActiveCell.Offset(-23, 1)) Then ActiveCell.Offset(-23, 1).Value = "0"
ActiveCell.Offset(0, 1).Select
Loop

Answer 1

在您的情况下，我将定义一个用户定义的函数（将宏放在标准模块中），然后在工作表中使用该函数作为公式。该函数返回最后一个非空单元格的值，然后您可以直接在工作表中执行计算。 Value2用于获取单元格的基础值，而不考虑格式。

看起来您对导航部分（问题标题）感兴趣。我向您展示了三种方法来获得最后一个（我希望我理解您的最后正确定义）非空单元格，宽度为1列：

• 循环范围（getLastValueWithLoop）
• 使用.End（xlUp）（getLastValueWithEnd）
• 将范围值写入数组然后循环数组（最快）（getLastValueWithArrayLoop）

我还包含了一个函数（updateDueDateInEachColumn），它遍历每一列并以编程方式更新截止日期，而不必使用用户定义的函数。

顺便说一句：你可以使用宏来使用普通公式（参见截图）。

代码：

' **
' Get the value of the last non empty cell in rng
' @param {Range} rng Range to look in, 1 column only
' @return {Variant} Returns the value of the last non empty cell
' or false if all cells are empty
' Example:
' Use following function inside a sheet:
' =getLastValueWithLoop(A2:A6)
Public Function getLastValueWithLoop(rng As Range) As Variant
    Dim i As Long

    ' Loop through range and check if cell is not empty
    ' Starts at the bottom and moves 1 cell up each time
    For i = rng.Cells.Count To 1 Step -1
        If rng(i).Value2 <> "" Then
            getLastValueWithLoop = rng(i).Value
            Exit Function
        End If
    Next

    ' if no value in range set to false
    getLastValueWithLoop = False
End Function

' **
' Get the value of the last non empty cell in rng
' @param {Range} rng Range to look in, 1 column only
' @return {Variant} Returns the value of the last non empty cell
' or false if all cells are empty
' Example:
' Use following function inside a sheet:
' =getLastValueWithEnd(A2:A6)
Public Function getLastValueWithEnd(rng As Range) As Variant
    Dim i As Long
    Dim lastCell As Range
    Dim lastNonEmptyCell As Range

    ' Set last cell in range
    Set lastCell = rng(rng.Cells.Count)

    ' Use .end(xlup) to get first non empty
    ' This is the same as using the keys CTRL + Up
    If lastCell <> "" Then
        ' Needs to check if last cell is empty first as else
        ' end(xlup) would move up even if the cell is non empty
        ' Set as last non empty cell if not empty
        getLastValueWithEnd = lastCell.Value2
        Exit Function
    Else
        ' Use end(xlup) to get the first non empty cell moving up from
        ' the last cell. Check if the cell found with end(xlup) is inside the range
        ' with .Intersect as end(xlup) can move outside the range provided
        ' If it is inside the range set last non empty cell
        If Not Application.Intersect(rng, lastCell.End(xlUp)) Is Nothing Then
            getLastValueWithEnd = lastCell.End(xlUp).Value2
            Exit Function
        End If
    End If

    ' if no value in range set to false
    getLastValueWithEnd = False
End Function

' **
' Get the value of the last non empty cell in rng
' @param {Range} rng Range to look in, 1 column only
' @return {Variant} Returns the value of the last non empty cell
' or false if all cells are empty
' Example:
' Use following function inside a sheet:
' =getLastValueWithArrayLoop(A2:A6)
Public Function getLastValueWithArrayLoop(rng As Range) As Variant
    Dim rngAsArray As Variant
    Dim i As Long

    ' Write the rng values into an array
    ' This produces a two dimensional array
    rngAsArray = rng.Value2

    ' Loop through the array, move from bottom up and
    ' return first non empty cell
    For i = UBound(rngAsArray, 1) To LBound(rngAsArray, 1) Step -1
        If rngAsArray(i, 1) <> "" Then
            getLastValueWithArrayLoop = rngAsArray(i, 1)
            Exit Function
        End If
    Next

    ' if no value in range set to false
    getLastValueWithArrayLoop = False
End Function

' **
' Check rngColumn for last value (exit if none found) and
' update rngDueDate then move one column to the right etc.
' This macro relies on the function getLastValueWithLoop.
' @param {Range} rngColumn First column range to get last value in
' @param {Range} rngDueDate First cell to update due date in
' Example call in macro:
' updateDueDateInEachColumn Range("B2:B6"), Range("B7")
Public Sub updateDueDateInEachColumn(rngColumn As Range, rngDueDate As Range)
    Dim rng As Range
    Dim lastValue As Variant

    ' Loop until column is empty
    Do
        ' Get last value of column range, returns false if no value found
        lastValue = getLastValueWithLoop(rngColumn)
        If lastValue = False Then
            ' Exit the loop if no value was found
            Exit Do
        Else
            ' Update due date
            rngDueDate = lastValue + 10 ' TODO: add your calculation here
        End If
        ' Offset column and due date range by one column
        Set rngColumn = rngColumn.Offset(, 1)
        Set rngDueDate = rngDueDate.Offset(, 1)
    Loop

End Sub

工作表内函数的示例用法：