Question

编码新手 - 请耐心等待我！

我正在尝试为工作簿打开时和工作表更改发生时启动的日期添加创建事件过程。

用户在范围F3：F50中手动输入“收尾”日期。反过来，我希望另一个日期自动插入D3：D50，即60天。

 Private Sub Workbook_Open()
    Sheet1.EventProc1 Sheet1.Range("D3:D50")
End Sub

^^我的理解：为指定范围的sheet1启动事件proc。

Private Sub Worksheet_Activate()
    EventProc1 Me.Range("D3:D50")
End Sub

^^打开工作表时会做同样的事情。

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    EventProc1 Intersect(Target, Me.Range("F3:F50"))

    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

^^这是它开始变得混乱的地方。我发现Intersect F3：F50认为我想要在F3中检测到新数据输入时发生工作表更改：F50（反过来应影响D3：D50）。

Sub EventProc1(rng As Range)
    Dim cell As Range
    Dim Closeout As Date

    If rng Is Nothing Then Exit Sub

    For Each cell In rng.Cells
        Closeout = Range("F3:F50").Value
            Select Case cell
                Case Date: Cells.Value = DateAdd("d", -60, Closeout)
                Case Else: Cells.ClearContents
            End Select
    Next
End Sub

^^我尝试主代码。我正在逐个调整它以试图让它工作，直到我的调试器开始给我一个类型不匹配错误的字符串“Closeout = Range（”F3：F50“）。值”和我的新手技能被难倒。< / p>

有什么建议吗？我将其设置为EventProc的原因是因为我将在它上面有更多的EventProcs。提前谢谢。

Answer 1

我认为这可以让你更接近你需要去的地方：

  Private Sub Worksheet_Change(ByVal Target As Range)
    'Should probably provide a better check for datatype as well here
    'but your previous code had several cells assigned to the date
        If Intersect(Target, Me.Range("F3:F50")) Is Nothing Then
        Else
        Application.ScreenUpdating = False
        Application.EnableEvents = False

        EventProc1 Target

        Application.EnableEvents = True
        Application.ScreenUpdating = True

        End If
    End Sub


    Sub EventProc1(rng As Range)
        Dim cell As Range
        Dim Closeout As Date
            Closeout = CDate(rng.Value) 
        Cells(4, rng.Column).Value = DateAdd("d", -60, Closeout)

    End Sub

编辑：好的，只需要随时调用此事件即可。它应滚动每个单元格并相应地每次都更新它。： - ）

Sub NewEventProc1()
    Dim rngCell as Range
    For Each rngCell in Range("F3:F50")
        If TypeName(rngCell) <> "String" Then
             Cells(4, rngCell.Column).Value = DateAdd("d", -60, rngCell.Value)
        End If
    Next
End Sub

Excel：日期的运行时错误13将一列添加到另一列

1 个答案: