Excel：运行时错误13为Date添加一列到另一列

新的编码 – 请忍受我！

我试图创build一个date添加事件过程，当工作簿打开时，当工作表变化发生时开始。

用户可以在范围F3：F50中手动input“closures”date。 反过来，我想另一个date自动插入范围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 

^^这是开始变得混乱的地方。 我做了相交F3：F50认为我想要在F3：F50中input新的数据（这又会影响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 

^^我的主要代码的尝试。 我正在调整它的一部分，试图让它工作，直到我的debugging器开始给我一个types不匹配错误string“closures=范围（”F3：F50“）。价值”和我的新手技能难住。

有什么build议么？ 我把它设置为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