在特定单元格发生变化时捕获数据

Question

当某些细胞发生变化时，我试图从特定细胞中捕获数据：

当单元格B5发生变化时，我想要捕获Sheet2中A列和B列中单元格B3和B4中的数据。

当单元格C5发生变化时，我还希望能够在C列和D表2中的单元格C3和C4中捕获数据。

宏确实这样做了 - 但是，当B5或C5发生变化时，它会从B列和B列中捕获数据。 C - 而不是当B5改变捕获来自单元格B3和B的数据时。 B4和当C5仅改变来自细胞C3和B的数据时C4。

非常感谢任何帮助 - 这是我目前的代码：

    Sub Worksheet_Calculate()
Worksheet_Change Range("B5:C5")
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

'Capture data when cell B5 changes
  If Not Intersect(Target, Range("B5")) Is Nothing Then
Application.EnableEvents = False
Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = Range("B3").Value
Application.EnableEvents = True
Application.EnableEvents = False
Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Value = Range("B4").Value
Application.EnableEvents = True

 End If

'Capture data when cell C5 changes
         If Not Intersect(Target, Range("C5")) Is Nothing Then
Application.EnableEvents = False
Sheets("Sheet2").Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Value = Range("C3").Value
Application.EnableEvents = True
Application.EnableEvents = False
Sheets("Sheet2").Range("D" & Rows.Count).End(xlUp).Offset(1, 0).Value = Range("C4").Value
Application.EnableEvents = True



  End If

End Sub

Answer 1

这似乎对我有用..

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim oWS As Worksheet: Set oWS = ThisWorkbook.Worksheets("Sheet2")

    Application.EnableEvents = False
    With oWS
        If Not Intersect(Range("B5"), Target) Is Nothing Then
            .Range("A" & .Rows.count).End(xlUp).Offset(1, 0).Value = .Range("B3").Value
            .Range("B" & .Rows.count).End(xlUp).Offset(1, 0).Value = .Range("B4").Value
        ElseIf Not Intersect(Range("C5"), Target) Is Nothing Then
            .Range("C" & .Rows.count).End(xlUp).Offset(1, 0).Value = .Range("C3").Value
            .Range("D" & .Rows.count).End(xlUp).Offset(1, 0).Value = .Range("C4").Value
        End If
    End With
    Application.EnableEvents = True
End Sub

修改

  

通过公式

更改单元格值时

如果您希望在通过公式更改单元格值时更新值，则方法不同：

首先，在Module中，声明公共变量：

Public sB5Value As String
Public sC5Value As String

然后，在Workbook_Open中捕获您的单元格的当前值

Private Sub Workbook_Open()
    With Thisworkbook.Worksheets("Sheet2")
        sB5Value = .Range("B5").Value
        aC5Value = .Range("C5").Value
    End With
End Sub

现在在你的Worksheet（我假设是 Sheet2 ）计算功能你可以执行检查

Private Sub Worksheet_Calculate()
   With Thisworkbook.Worksheets("Sheet2")
       ' B5 change check
       If .Range("B5").Value <> sB5Value Then
           .Range("A" & .Rows.count).End(xlUp).Offset(1, 0).Value = .Range("B3").Value
           .Range("B" & .Rows.count).End(xlUp).Offset(1, 0).Value = .Range("B4").Value

           ' We have to update the value for B5 in the variable
           sB5Value = .Range("B5").Value
       End If

       ' C5 change check
       If .Range("C5").Value <> sC5Value Then
           .Range("C" & .Rows.count).End(xlUp).Offset(1, 0).Value = .Range("C3").Value
           .Range("D" & .Rows.count).End(xlUp).Offset(1, 0).Value = .Range("C4").Value

           ' We have to update the value for C5 in the variable
           sC5Value = .Range("C5").Value
       End If
    End With
End Sub

注意：如果需要，我已将原始代码保留为原因。 您还可以使IF条件不区分大小写（即使用 LCase 或 UCase ），但我会留给您。我没有测试过这段代码，但这个想法应该可行