Excel VBA中的多范围相交 [英] Multiple Range Intersect in excel VBA
问题描述
为什么这不起作用? 我试图让excel检查B列和D列是否有任何更改(如果B列已更改,然后执行一些操作,等等).
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运行第一个相交并退出子. 为什么不运行第二个相交? 在此先感谢
Excel run the first intersec and exit the sub. why doesnt it run the second intersect? Thanks in Advance
推荐答案
将第一个相交"更改为
If Intersect(Target, Range("B:B, D:D")) Is Nothing Then Exit Sub
...并输掉第二个.解析Target中的每个单元格(可以多于1个),这样您就不会崩溃,
... 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
这是我使用标准Worksheet_Change样板代码重写的内容. 请注意, lc 似乎没有值.
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
您可能还希望将vlookup切换到索引/匹配并将结果捕获到可以测试无匹配错误的变体中.
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.
这篇关于Excel VBA中的多范围相交的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!