将单元格的先前值与当前值进行比较

Question

“O2:O20”范围内的每个单元格都填充有数值。这些单元格中的每一个旁边都有一个单元格，该单元格也填充有数值，具体取决于 "O2: 020" 中存在的值。例如：如果 "O2" = 10.2 则其一侧的单元格 "P2" = 1000 但随后 "P2" = 500，则 "P2" = 600，然后 "P2" = 50；简而言之，"P2" 可以取任何正的自然值。我想计算 "P2" 所采用的先前值与只要 "O2" 保持相同值就可以采用的当前值之间的差异。如果 "O2" 的值发生变化，那么差异对我来说并不重要：例如：如果 "O2" = 10.2 and "P2" = 50 然后 "O2" = 10 and "P2" = 3000，在这种情况下，不，我想知道区别，因为两个单元格的 "O2" 不一样。

Answer 1

此解决方案使用工作表的更多列来存储要与实际值进行比较的先前值。在我的示例中，单元格 O2 和 O3 中的值将始终相同。

Sub Populate_OandP()

'Store previous values
Call PreviousValues

'This code just simulates the data population in columns O and P
                Dim intRndNumber As Integer

                Range("O2").Value = 10.2
                Range("O3").Value = 10

                intRndNumber = Int((10 - 1 + 1) * Rnd + 1)

                For i = 4 To 20
                    intRndNumber = Int((10 - 1 + 1) * Rnd + 1)
                    Cells(i, 15).Value = intRndNumber * 10
                Next i

                For i = 2 To 20
                    intRndNumber = Int((10 - 1 + 1) * Rnd + 1)
                    Cells(i, 16).Value = intRndNumber * 10
                Next i

'Check differences
Call CheckDifferenceIfOChanges    

End Sub

Sub PreviousValues()

For i = 2 To 20
    Cells(i, 18).Value = Cells(i, 15).Value
    Cells(i, 19).Value = Cells(i, 16).Value
Next i

End Sub

Sub CheckDifferenceIfOChanges()

For i = 2 To 20
    If Cells(i, 18).Value = Cells(i, 15).Value Then
        Cells(i, 20).Value = Cells(i, 19).Value - Cells(i, 16).Value
    Else: Cells(i, 20).Value = "O columns value changed"
    End If
Next i

End Sub

Answer 2

希望我能理解你的问题。请参阅此解决方案。它正在使用 Option Base 1。更新了将差异写入 Q 列的程序。如果不需要该消息，请删除或删除最后一个 MsgBox 的行。

Option Base 1
Private Sub Worksheet_Change(ByVal Target As Range)
    'Static declaration to safe the previous values and change status
    Static vO As Variant
    Static vP As Variant
    Static bolOChanged() As Boolean
    
    'Set up the ranges
    Dim rngO As Range, rngP As Range, rngQ As Range
    Set rngO = ThisWorkbook.ActiveSheet.Range("O2:O20")
    Set rngP = ThisWorkbook.ActiveSheet.Range("P2:P20")
    Set rngQ = ThisWorkbook.ActiveSheet.Range("Q2:Q20") 'Range for results
    
    'If the change is not in the range then ignore
    If Intersect(Union(rngO, rngP), Target) Is Nothing Then Exit Sub
    
    'Prevent unhandelt multiply changes. If multiply changes required than the
    'Target range shall be loop through
    If Target.Cells.Count > 1 Then
        Application.EnableEvents = False
        rngO.Value = vO
        rngP.Value = vP
        Application.EnableEvents = True
        MsgBox "You cannot change more the one cell in the range of: " & Union(rngO, rngP).Address
        Exit Sub
    End If
    
    'At the firs occasion the current status has to be saved
    If VarType(vO) < vbArray Then
        vO = rngO.Value
        vP = rngP.Value
        ReDim bolOChanged(1 To UBound(vO))
    End If
    
    Dim iIndex As Long 'Adjust the index of the array to the Row of Target cell
    iIndex = Target.Row - rngO(1).Row + 1
    
    If Not Intersect(rngO, Target) Is Nothing Then
        'Change was in O range, so next P change shall be ignored
        bolOChanged(iIndex) = True
    Else
        'rngP changed
        If bolOChanged(iIndex) Then
            'There was a previous O range change, ignore
            bolOChanged(iIndex) = False 'Delete the recent change flag
            vP(iIndex, 1) = Target.Value 'Store the value
        Else
            rngQ(iIndex).Value = Target.Value - vP(iIndex, 1)
            MsgBox "Value change from: " & vP(iIndex, 1) & ", to: " & Target.Value & ". Difference is: " & Target.Value - vP(iIndex, 1)
            vP(iIndex, 1) = Target.Value 'Store the value
        End If
    End If
End Sub

更新：此版本正在处理乘法条目。

Option Base 1
Private Sub Worksheet_Change(ByVal Target As Range)
    'Static declaration to safe the previous values and change status
    Static vO As Variant
    Static vP As Variant
    Static bolOChanged() As Boolean
    
    'Set up the ranges
    Dim rngO As Range, rngP As Range, rngQ As Range
    Set rngO = ThisWorkbook.ActiveSheet.Range("O2:O20")
    Set rngP = ThisWorkbook.ActiveSheet.Range("P2:P20")
    Set rngQ = ThisWorkbook.ActiveSheet.Range("Q2:Q20") 'Range for results
    
    'If the change is not in the range then ignore
    If Intersect(Union(rngO, rngP), Target) Is Nothing Then Exit Sub
        
    'At the firs occasion the current status has to be saved
    If VarType(vO) < vbArray Then
        vO = rngO.Value
        vP = rngP.Value
        ReDim bolOChanged(1 To UBound(vO))
    End If
    
    Dim iIndex As Long 'Adjust the index of the array to the Row of Target cell
    Dim item As Variant
    For Each item In Target
        iIndex = item.Row - rngO(1).Row + 1
        If Not Intersect(rngO, item) Is Nothing Then
            'Change was in O range, so next P change shall be ignored
            bolOChanged(iIndex) = True
        Else
            'rngP changed
            If bolOChanged(iIndex) Then
                'There was a previous O range change, ignore
                bolOChanged(iIndex) = False 'Delete the recent change flag
                vP(iIndex, 1) = item.Value 'Store the value
            Else
                rngQ(iIndex).Value = item.Value - vP(iIndex, 1)
                MsgBox "Value changed in cell " & item.Address & " from: " & vP(iIndex, 1) & ", to: " & item.Value & ". Difference is: " & item.Value - vP(iIndex, 1)
                vP(iIndex, 1) = item.Value 'Store the value
            End If
        End If
    Next item
End Sub

将单元格的先前值与当前值进行比较

Compare the previous value of a cell with the current one

excel

vba

record