Question

我有一个工作表，它计算A列中指定日期和B列中今天（）日期之间的天数，如果D列中有“CLOSED”字样，则会停止C列中的计数。但我有如果列D再次为空，我想重新应用公式的问题。我不确定如何使列行出现在正确的位置以供公式使用

以下是VBA代码：

Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Cells = "CLOSED" Then
'Run only when change is made in Column D
  If Target.Column = 4 Then
   Application.EnableEvents = False
'Replace the formula with the current result
    Range("C" & Target.Row) = Range("C" & Target.Row).Value
    Range("B" & Target.Row) = Range("B" & Target.Row).Value
   Application.EnableEvents = True
  End If
 End If

  If Target.Cells = "" Then
'Run only when change is made in Column D
  If Target.Column = 4 Then
   Application.EnableEvents = False
'Replace the formula with the current result
    Range("C" & Target.Row).Formula = "=TRUNC($B2 - $A2)"
    Range("B" & Target.Row).Value = "=Today()"
   Application.EnableEvents = True
  End If
 End If
End Sub

如果有人可以教我如何正确更改代码，我将非常感激：

Range("C" & Target.Row).Formula = "=TRUNC($B2 - $A2)"

因为我还是VBA编程的新手，想从错误中吸取教训

Answer 1

下面会做你想要的。了解您可以使用.FormulaR1C1类似于填充/缩小的效果。包括1个以上单元格在内的潜在问题已发生变化。如果A / B列中的单元格为空，则不要检查。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim oRng As Range

    Application.EnableEvents = False
    For Each oRng In Target.Cells
        With oRng
            If .Column = 4 Then
                If UCase(Trim(.Value)) = "CLOSED" Then
                    .Worksheet.Cells(.Row, "B").Value = .Worksheet.Cells(.Row, "B").Value
                    .Worksheet.Cells(.Row, "C").Value = .Worksheet.Cells(.Row, "C").Value
                ElseIf Len(Trim(.Value)) = 0 Then
                    .Worksheet.Cells(.Row, "B").Formula = "=Today()"
                    .Worksheet.Cells(.Row, "C").FormulaR1C1 = "=TRUNC(RC[-2]-RC[-3])"
                End If
            End If
        End With
    Next oRng
    Application.EnableEvents = True

End Sub

Answer 2

我的理解是：

您需要针对任何第4列单元格更改进行操作，仅
第4列中可以有多个更改的单元格

所以我会像下面这样（评论中的解释）：

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rangeToProcess As Range

    Set rangeToProcess = Intersect(Target, Columns(4)) 'mind edited cells in column 4 only
    If rangeToProcess Is Nothing Then Exit Sub

    Dim cell As Range
    Application.EnableEvents = False
    For Each cell In rangeToProcess 'loop through edited cells in column 4
        With cell.Offset(, -2).Resize(, 2) ' reference a 2-cells range at the left of current cell
            Select Case cell.Value 'process current cell value
                Case "CLOSED" ' if it's "CLOSED" ...
                    .Value = .Value ' ... then leave values in referenced cells
                Case "" ' if it's "" ...
                    .FormulaR1C1 = Array("=Today()", "=TRUNC(RC[-1]-RC[-2])") ' ... then restore formulas
            End Select
        End With
    Next
    Application.EnableEvents = True
End Sub

应用将行位置更改为VBA的公式

2 个答案: