VBA Excel – 如何自动填充多栏中的date，如果我填充列A

这是我第一次写代码，我尝试写一个代码，这可以帮助我自动填充列B ， C和D，这将会发生在我自己填充列A时发生。

这是我现在工作的工作表的图片工作表解释我想要什么

最终的结果必须是这样的图片

我尝试谷歌的代码，我发现了一个代码，但它不工作

这是第一个代码

Private Sub Worksheet_Change(ByVal Target As Range) Dim A As Range, B As Range, Inte As Range, r As Range Set A = Range("A:A") Set Inte = Intersect(A, Target) If Inte Is Nothing Then Exit Sub Application.EnableEvents = False For Each r In Inte r.Offset(0, 1).Value = Date Next r Application.EnableEvents = True End Sub 

我也试着写另一个代码，这可能会帮助我根据上面的代码结果填充列B和C ，但仍然无法正常工作。

这是我写的代码

 Private Sub Worksheet_Change1(ByVal Target As Range) Dim i As Integer For i = 6 To 1000 If Cells(i, "A").Value <> "" And Cells(i, "B").Value <> "" Then Cells(i, "C").Value = Date Cells(i, "C").NumberFormat = "mmm" Cells(i, "D").Value = Date Cells(i, "D").NumberFormat = "yyyy" End If Next Range("C:C").EntireColumn.AutoFit Range("D:D").EntireColumn.AutoFit End Sub 

任何人都可以帮忙吗？

Answer 1

当工作表上的一个或多个单元格更改值时， Worksheet_Change事件macros被触发。 如果您在不事先closures事件处理的情况下将值写入Worksheet_Change过程中的工作表中（就像使用date一样），则会触发另一个Worksheet_Change并且该过程试图在其本身之上运行。 在将值写入工作表之前，应始终使用Application.EnableEvents = Falseclosures事件处理。

 Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("A:B")) Is Nothing Then On Error GoTo bm_Safe_Exit Application.EnableEvents = False Dim rw As Long, rng As Range For Each rng In Intersect(Target, Range("A:B")) If Application.CountA(Cells(rng.Row, "A").Resize(1, 2)) = 2 Then Cells(rng.Row, "C").Resize(1, 2).Value = Date Cells(rng.Row, "C").NumberFormat = "mmmm" Cells(rng.Row, "D").NumberFormat = "yyyy" End If Next rng Range("C:C").EntireColumn.AutoFit Range("D:D").EntireColumn.AutoFit End If bm_Safe_Exit: If CBool(Val(Err.Number)) Then _ Debug.Print Err.Number & ": " & Err.Description Application.EnableEvents = True End Sub 

请记住，在退出Worksheet_Change过程之前，使用Application.EnableEvents = True重新开启事件，否则将来的值更改将不会再次触发Worksheet_Change过程。

顺便说一句， 10月份的正确数字格式是mmmm ，而不是mmm 。 前者给出完整的月份名称; 后者只有三个字母的缩写（如Oct ）。