intersect 相交 范围_Excel VBA中的多范围相交

Why does this not work?

I'm trying to get excel to check for any changes in column B and D if column B has changed then do some actions and so on.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim lc As Long

Dim TEMPVAL As String

Dim ws1, ws2 As Worksheet

Dim myDay As String

Set ws1 = ThisWorkbook.Sheets("Lists")

myDay = Format(myDate, "dddd")

If Intersect(Target, Range("B:B")) Is Nothing Then Exit Sub

If Target = "" Then Exit Sub

MsgBox "Row: " & Target.Row & "Column: " & lc

With Application

.EnableEvents = False

.ScreenUpdating = False

Cells(Target.Row, lc + 1) = Target.Row - 1

Cells(Target.Row, lc + 3) = Format(myDate, "dd-MMM-yyyy")

Cells(Target.Row, lc + 4) = Application.WorksheetFunction.VLookup(Target, ws1.Range("A2:C29").Value, 3, False)

Cells(Target.Row, lc + 5) = 7.6

Cells(Target.Row, lc + 7) = Application.WorksheetFunction.VLookup(Target, ws1.Range("A2:C29").Value, 2, False)

Cells(Target.Row, lc + 8) = myDay

Cells(Target.Row, lc + 10) = WORKCODE(Target.Row, lc + 4)

.EnableEvents = True

.ScreenUpdating = True

End With

If Intersect(Target, Range("D2:D5002")) Is Nothing Then Exit Sub

If Target = "" Then Exit Sub

MsgBox "Row: " & Target.Row & "Column: " & lc

With Application

.EnableEvents = False

.ScreenUpdating = False

Cells(Target.Row, lc + 10) = WORKCODE(Target.Row, lc + 4)

.EnableEvents = True

.ScreenUpdating = True

End With

End Sub

Excel run the first intersec and exit the sub.

why doesnt it run the second intersect?

Thanks in Advance

解决方案

Change the first Intersect to,

If Intersect(Target, Range("B:B, D:D")) Is Nothing Then Exit Sub

... and lose the second. Parse each cell in Target (there can be more than 1) so you don't crash on things like,

If Target = "" Then Exit Sub

Here is my rewrite using standard Worksheet_Change boilerplate code. Note that lc does not appear to have a value.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

'COULD NOT FIND ANY CODE TO ASSIGN A VALUE TO lc

'myDate ALSO APPEARS TO BE A PUBLIC PREDEFINED VAR

If Not Intersect(Target, Range("B:B, D:D")) Is Nothing Then

On Error GoTo safe_exit

With Application

.EnableEvents = False

.ScreenUpdating = False

Dim lc As Long, trgt As Range, ws1 As Worksheet

Set ws1 = ThisWorkbook.Worksheets("Lists")

For Each trgt In Intersect(Target, Range("B:B, D:D"))

If trgt <> vbNullString Then

Select Case trgt.Column

Case 2 'column B

Cells(trgt.Row, lc + 1) = trgt.Row - 1

Cells(trgt.Row, lc + 3) = Format(myDate, "dd-mmm-yyyy")

Cells(trgt.Row, lc + 4) = .VLookup(trgt, ws1.Range("A2:C29").Value, 3, False)

Cells(trgt.Row, lc + 5) = 7.6

Cells(trgt.Row, lc + 7) = .VLookup(trgt, ws1.Range("A2:C29").Value, 2, False)

Cells(trgt.Row, lc + 8) = Format(myDate, "dddd")

Cells(trgt.Row, lc + 10) = WORKCODE(trgt.Row, lc + 4) '

Case 4 'column D

'do something else

End Select

End If

MsgBox "Row: " & Target.Row & "Column: " & lc

Next trgt

Set ws1 = Nothing

End With

End If

safe_exit:

Application.EnableEvents = True

Application.ScreenUpdating = True

End Sub

You also might want to switch vlookup to an index/match and catch the result in a variant which can be tested for no match error.