Trying to run a worksheet change event twice

问题

I am trying to run this worksheet change event for two different columns(A) and (I)...

    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

This event is something i found on this forum. Its purpose is to make it so whenever data is ever entered into column "a" it auto inputs the date into the cell directly right of it. I want this to happen twice on the worksheet. I can't figure out how to change/add to it. I am trying to get it to run the logic for column A and I on my spreadsheet.

回答1:

edited after OP's comment

expanding on @Jeeped solution, you can avoid looping:

Option Explicit

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

    Set rng = Intersect(Range("A:A, I:I"), Target) ' define range of interest
    If Not rng Is Nothing Then ' check it's not "nothing"
        If WorksheetFunction.CountA(rng) = rng.Count Then 'check for all of its cells being not empty
            On Error GoTo safe_exit 'add error control
            Application.EnableEvents = False 'don't do anything until you know something has to be done
            rng.Offset(, 1).Value = Date 'write Date next to all relevant changed cells
        End If
    End If

safe_exit:
    Application.EnableEvents = True
End Sub

回答2:

Just expand the range you set to the A variable.

Set A = Range("A:A, I:I")

Rewritten as,

Private Sub Worksheet_Change(ByVal Target As Range)
    if not intersect(range("A:A, I:I"), target) is nothing then
        'add error control
        on error goto safe_exit
        'don't do anything until you know something has to be done
        dim r as range
        Application.EnableEvents = False
        For Each r In intersect(range("A:A, I:I"), target)
            r.Offset(0, 1).Value = Date   'do you want Date or Now?
        Next r
    end if
safe_exit:
    Application.EnableEvents = True 
End Sub

来源：https://stackoverflow.com/questions/48898113/trying-to-run-a-worksheet-change-event-twice

标签

excel

vba

excel-vba

worksheet

intersect