希望我能理解您的问题。请参阅此解决方案。
它正在使用 Option Base 1。
更新了将差异写入 Q 列的程序。
如果不需要该消息,请删除或 Rem 最后一个 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