跟踪值的变化并在一系列单元格中发布

时间:2017-10-18 15:58:35

标签: excel-vba tracking recording vba excel

我有两个单元格,每个单元格从一个独立的系列中返回总数。我想在每次更改任一单元格时将这些总计在新单元格中发布,每次都记录两个单元格的值。这是一个记分表,可以跟踪每次对任一单元格进行更改时显示该分数的运行分数。

示例:

Example

2 个答案:

答案 0 :(得分:0)

重要!

这需要粘贴到Sheet1对象中。您可以通过右键点击Sheet1标签>来实现目标。查看代码。

另外,我只进行了极少的测试。如果这对你有用,请告诉我。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Debug.Print Now; " >> ws1 Value Chg'd @ "; Target.Address
    Dim ws As Worksheet, iSectAY As Range, iSectDB As Range
    Dim RngAY As Range, RngDB As Range
    Dim RngAR As Range, RngCU As Range

    Set ws = ThisWorkbook.Worksheets(1)
    Set RngAR = ws.Range("AR67")
    Set RngCU = ws.Range("CU67")
    Set RngAY = ws.Range("AY:AY")
    Set RngDB = ws.Range("DB:DB")

    'Determine if the cell changed is a target cell
    Set iSectAY = Intersect(Target, RngAY)
    Set iSectDB = Intersect(Target, RngDB)
    Dim iRow As Integer
    If Not iSectAY Is Nothing Then
        iRow = 1
        If RngCU = "" Then
            Application.EnableEvents = False
            RngCU = 0
            Application.EnableEvents = True
        End If
    ElseIf Not iSectDB Is Nothing Then
        iRow = 2
        If RngAR = "" Then
            Application.EnableEvents = False
            RngAR = 0
            Application.EnableEvents = True
        End If
    Else
        Exit Sub    'Cell updated was not the target
    End If

    'Set Sheet2's objects
    Dim ws2 As Worksheet, UpdateRng1 As Range, UpdateRng2 As Range, iCol As Long
    Set ws2 = ThisWorkbook.Worksheets(2)
    iCol = ws2.Cells(iRow, Columns.Count).End(xlToLeft).Column + 1
    Set UpdateRng1 = ws2.Cells(1, iCol)
    Set UpdateRng2 = ws2.Cells(2, iCol)

    UpdateRng1 = RngAR.Value
    UpdateRng2 = RngCU.Value

End Sub

答案 1 :(得分:0)

我将以下内容与编辑命令按钮结合使用以获得所需的结果

Private Sub CommandButton108_Click()
Range("CI7") = Range("CI7") + 2
Range("CA7") = Range("CA7") + 2
Range("DH7") = Range("DH7")
End Sub
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Debug.Print Now; " >> ws1 Value Chg'd @ "; Target.Address
    Dim ws As Worksheet, iSectAY As Range, iSectDH As Range
    Dim RngAY As Range, RngDB As Range
    Dim RngAR As Range, RngCU As Range

    Set ws = ThisWorkbook.Worksheets(1)
    Set RngAR = ws.Range("AR67")
    Set RngCU = ws.Range("CU67")
    Set RngAY = ws.Range("AY7:AY63")
    Set RngDH = ws.Range("DH7:DH63")

    'Determine if the cell changed is a target cell
    Set iSectAY = Intersect(Target, RngAY)
    Set iSectDH = Intersect(Target, RngDH)
    Dim iRow As Integer
    If Not iSectAY Is Nothing Then
        iRow = 1
        If RngCU = "" Then
            Application.EnableEvents = False
            RngCU = 0
            Application.EnableEvents = True
        End If
    ElseIf Not iSectDH Is Nothing Then
        iRow = 2
        If RngAR = "" Then
            Application.EnableEvents = False
            RngAR = 0
            Application.EnableEvents = True
        End If
    Else
        Exit Sub    'Cell updated was not the target
    End If

    'Set Sheet4's objects
    Dim ws4 As Worksheet, UpdateRng1 As Range, UpdateRng2 As Range, iCol As Long
    Set ws4 = ThisWorkbook.Worksheets(4)
    iCol = ws4.Cells(iRow, Columns.Count).End(xlToLeft).Column + 1
    Set UpdateRng1 = ws4.Cells(1, iCol)
    Set UpdateRng2 = ws4.Cells(2, iCol)

    UpdateRng1 = RngAR.Value
    UpdateRng2 = RngCU.Value

End Sub