求助：修改VBA代码实现多列输入数据后自动填充日期和时间

嗨，我看了你的需求和现有代码，原来的代码已经能实现C列输入数据时，自动在A列填日期、B列填时间，但你现在想把这个功能扩展到其他列对吧？先给你提个原代码里的小bug：你写的If Target.Offset(0, -2).Value = "" And Target.Offset(0, -2).Value = "" Then其实重复判断了同一个单元格，逻辑上应该是检查左边两列都为空，也就是改成If Target.Offset(0, -2).Value = "" And Target.Offset(0, -1).Value = "" Then，不然这个判断大概率不会正常触发哦。

接下来针对你要扩展到多列的需求，我给你两种实用的修改方案，你可以根据自己的实际场景选择：

方案一：指定具体的触发列 #

如果你已经明确知道哪些列需要触发自动填充（比如C列、E列、G列，对应列号3、5、7），用这个方案最直接。代码里把需要触发的列号放到一个数组里，只要输入的列在这个数组内，就会自动给左边两列填充日期和时间：

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    ' 保留你原有的高级过滤逻辑
    If Not Intersect(Target, Range("Input")) Is Nothing Then
        Application.EnableEvents = False
        On Error Resume Next
        ActiveSheet.ShowAllData
        On Error GoTo 0
        Range("MyList").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("Criteria"), Unique:=False
        Application.EnableEvents = True
    End If
    
    ' 定义需要触发自动填充的列号，比如3=C列,5=E列,7=G列，可自行添加或删除
    Dim triggerColumns As Variant
    triggerColumns = Array(3, 5, 7)
    Dim col As Variant
    Dim isTriggerCol As Boolean
    isTriggerCol = False
    
    ' 检查当前输入的列是否在触发列列表里
    For Each col In triggerColumns
        If Target.Column = col Then
            isTriggerCol = True
            Exit For
        End If
    Next col
    
    ' 如果不是指定的触发列，直接退出程序
    If Not isTriggerCol Then Exit Sub
    
    Application.EnableEvents = False
    ' 检查左边两列是否都为空，是的话填充日期和时间
    If Target.Offset(0, -2).Value = "" And Target.Offset(0, -1).Value = "" Then
        Target.Offset(0, -2).Value = Date
        Target.Offset(0, -1).Value = Time
    End If
    Application.EnableEvents = True
End Sub

使用时你只要修改triggerColumns = Array(3, 5, 7)里的数字就行，比如要加F列（第6列），就改成Array(3,5,6,7)。

方案二：按规则自动触发 #

如果你想按固定规律来触发（比如每3列一组：3、6、9...列，对应左边两列填日期时间），这个方案更灵活，不用每次加列都改数组：

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    ' 保留你原有的高级过滤逻辑
    If Not Intersect(Target, Range("Input")) Is Nothing Then
        Application.EnableEvents = False
        On Error Resume Next
        ActiveSheet.ShowAllData
        On Error GoTo 0
        Range("MyList").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("Criteria"), Unique:=False
        Application.EnableEvents = True
    End If
    
    ' 触发规则：列号为3、6、9...（即列号减3后能被3整除，且列号不小于3）
    ' 你可以自行修改规则，比如要所有奇数列触发就写 Target.Column Mod 2 = 1
    Dim triggerRule As Boolean
    triggerRule = (Target.Column - 3) Mod 3 = 0 And Target.Column >=3
    
    If Not triggerRule Then Exit Sub
    
    Application.EnableEvents = False
    ' 检查左边两列是否都为空，是的话填充日期和时间
    If Target.Offset(0, -2).Value = "" And Target.Offset(0, -1).Value = "" Then
        Target.Offset(0, -2).Value = Date
        Target.Offset(0, -1).Value = Time
    End If
    Application.EnableEvents = True
End Sub

这个方案的好处是只要列号符合你设定的规则，就会自动触发功能，不用手动维护列号列表。

最后提醒下：修改完代码后记得把文件保存为.xlsm格式，不然宏会丢失；测试前最好先复制一份文件备份，避免意外影响数据哦～

备注：内容来源于stack exchange，提问作者Sagar Rana