excel VBA中的多个范围相交

Question

为什么这不起作用？ 我正在尝试让 excel 检查 B 列和 D 列中的任何更改，如果 B 列发生更改，然后执行一些操作等等。

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 运行第一个 intersec 并退出 sub。 为什么它不运行第二个相交？ 提前致谢

Answer 1

将第一个相交改为，

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

...然后输掉第二个。解析 Target 中的每个单元格（可以有超过 1 个），这样您就不会因为类似的事情而崩溃，

If Target = "" Then Exit Sub

这是我使用标准 Worksheet_Change 样板代码重写的。 请注意，lc 似乎没有值。

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 切换到索引/匹配，并将结果捕获到一个可以测试无匹配错误的变体中。

Answer 2

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
    If Target.Column = 2 Then
        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(Date, "dd-MMM-yyyy")
            Cells(Target.Row, lc + 4) = Application.WorksheetFunction.VLookup(Target, ws1.Range("A2:C29"), 3, False)
            Cells(Target.Row, lc + 5) = 7.6
            Cells(Target.Row, lc + 7) = Application.WorksheetFunction.VLookup(Target, ws1.Range("A2:C29"), 2, False)
            Cells(Target.Row, lc + 8) = myDay
            Cells(Target.Row, lc + 10) = WORKCODE(Target.Row, lc + 4)
          .EnableEvents = True
          .ScreenUpdating = True
        End With

    ElseIf Target.Column = 4 Then
    '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 If
End Sub