Мне нужно было захватить и сравнить старые значения с новыми значениями, введенными в электронную таблицу сложного планирования.Мне нужно было общее решение, которое работало даже тогда, когда пользователь изменил много строк одновременно.В решении реализованы класс и коллекция этого класса.
Класс: oldValue
Private pVal As Variant
Private pAdr As String
Public Property Get Adr() As String
Adr = pAdr
End Property
Public Property Let Adr(Value As String)
pAdr = Value
End Property
Public Property Get Val() As Variant
Val = pVal
End Property
Public Property Let Val(Value As Variant)
pVal = Value
End Property
Существует три листа, в которых я отслеживаю ячейки.Каждый лист получает свою собственную коллекцию в виде глобальной переменной в модуле с именем ProjectPlan следующим образом:
Public prepColl As Collection
Public preColl As Collection
Public postColl As Collection
Public migrColl As Collection
SUB InitDictionaries вызывается из worksheet.open для создания коллекций.
Sub InitDictionaries()
Set prepColl = New Collection
Set preColl = New Collection
Set postColl = New Collection
Set migrColl = New Collection
End Sub
Для управления каждой коллекцией объектов oldValue, таких как Add, Exists и Value, используются три модуля.
Public Sub Add(ByRef rColl As Collection, ByVal sAdr As String, ByVal sVal As Variant)
Dim oval As oldValue
Set oval = New oldValue
oval.Adr = sAdr
oval.Val = sVal
rColl.Add oval, sAdr
End Sub
Public Function Exists(ByRef rColl As Collection, ByVal sAdr As String) As Boolean
Dim oReq As oldValue
On Error Resume Next
Set oReq = rColl(sAdr)
On Error GoTo 0
If oReq Is Nothing Then
Exists = False
Else
Exists = True
End If
End Function
Public Function Value(ByRef rColl As Collection, ByVal sAdr) As Variant
Dim oReq As oldValue
If Exists(rColl, sAdr) Then
Set oReq = rColl(sAdr)
Value = oReq.Val
Else
Value = ""
End If
End Function
Тяжелая работа выполняется в обратном вызове Worksheet_SelectionChange.Один из четырех показан ниже.Единственным отличием является коллекция, используемая в вызовах ADD и EXIST.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim mode As Range
Set mode = Worksheets("schedule").Range("PlanExecFlag")
If mode.Value = 2 Then
Dim c As Range
For Each c In Target
If Not ProjectPlan.Exists(prepColl, c.Address) Then
Call ProjectPlan.Add(prepColl, c.Address, c.Value)
End If
Next c
End If
End Sub
Вызов VALUE вызывается из кода, выполняемого, например, из обратного вызова Worksheet_Change.Мне нужно назначить правильную коллекцию на основе имени листа:
Dim rColl As Collection
If sheetName = "Preparations" Then
Set rColl = prepColl
ElseIf sheetName = "Pre-Tasks" Then
Set rColl = preColl
ElseIf sheetName = "Migr-Tasks" Then
Set rColl = migrColl
ElseIf sheetName = "post-Tasks" Then
Set rColl = postColl
Else
End If
, а затем я могу свободно вычислять сравнение текущего значения с исходным значением.
If Exists(rColl, Cell.Offset(0, 0).Address) Then
tsk_delay = Cell.Offset(0, 0).Value - Value(rColl, Cell.Offset(0, 0).Address)
Else
tsk_delay = 0
End If
Mark