Я пытаюсь написать макрос, который будет определять последнюю метку времени в столбце, добавлять определенное количество дней и обновлять срок выполнения для каждого столбца в моем наборе данных, пока он не достигнет пустого столбца.
Это снимок экрана с набором данных, в котором я хочу запустить функцию calc:
Для других расчетов я использую 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
Добро пожаловать! Всегда лучше встроить изображение, чем давать ссылку.
В вашем случае я бы определил определяемую пользователем функцию (поместил макрос в стандартный модуль), а затем использовал бы эту функцию внутри листа как формулу. Функция возвращает значение последней непустой ячейки, после чего вы можете выполнить расчет прямо на листе. Value2
используется для получения базового значения ячейки без учета форматов.
Похоже, вас интересует навигационная часть (заголовок вопроса). Я покажу вам три способа получить последнюю (надеюсь, я правильно понял ваше определение last) непустую ячейку в диапазоне шириной в 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
Пример использования функций внутри листа:
В общем, хочется избегайте использования
Select
иActiveCell
. Среди преимуществ - облегчение просмотра ячеек на листе.