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屋！