Определить, действительно ли значение ячейки было изменено путем редактирования

Worksheet_Change триггеры, когда значение ячейки изменяется (это то, что я хочу), но оно также запускается, когда вы вводите ячейку, как если бы ее редактировать, но на самом деле не изменяете значение ячейки (и это то, что я не хотят этого делать).

Скажем, я хочу добавить штриховку в ячейки, значение которых было изменено. Поэтому я кодирую это:

Private Sub Worksheet_Change(ByVal Target As Range)
    Target.Interior.ColorIndex = 36
End Sub

Теперь, чтобы проверить мою работу: измените ячейку A1 и ячейка подсвечивается. Это желаемое поведение. Все идет нормально. Затем дважды щелкните B1, но не изменяйте значение там, а затем нажмите C1. Вы заметите, что B1 подсвечивается! И это не желаемое поведение.

Нужно ли мне переходить к рассмотренным здесь методам сбора старого значения, а затем сравнивать старые с новыми, прежде чем выделять ячейку? Я, конечно, надеюсь, что там что-то мне не хватает.

Ответ 1

Я предлагаю автоматически сохранять "зеркальную копию" вашего листа на другом листе для сравнения с измененным значением ячейки.

@brettdj и @JohnLBevan по существу предлагают делать то же самое, но они хранят значения ячеек в комментариях или словаре соответственно (и +1 для этих идей). Мое чувство, однако, состоит в том, что концептуально гораздо проще создавать резервные копии ячеек в ячейках, а не в других объектах (особенно комментарии, которые вы или пользователь может захотеть использовать для других целей).

Итак, скажем, у меня есть Sheet1, чьи ячейки пользователь может изменить. Я создал этот другой лист под названием Sheet1_Mirror (который вы могли бы создать в Workbook_Open и мог бы быть скрытым, если вы этого захотите - до вас). Начнем с того, что содержимое Sheet1_Mirror будет идентично содержимому Sheet1 (опять же, вы можете применить это в Workbook_Open).

Каждый раз, когда срабатывает Sheet1 Worksheet_Change, код проверяет, действительно ли значение "измененной" ячейки в Sheet1 отличается от значения в Sheet1_Mirror. Если это так, оно выполняет требуемое действие и обновляет зеркальный лист. Если нет, то ничего.

Это должно привести вас к правильному пути:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Range
    For Each r In Target.Cells
        'Has the value actually changed?
        If r.Value <> Sheet1_Mirror.Range(r.Address).Value Then
            'Yes it has. Do whatever needs to be done.
            MsgBox "Value of cell " & r.Address & " was changed. " & vbCrLf _
                & "Was: " & vbTab & Sheet1_Mirror.Range(r.Address).Value & vbCrLf _
                & "Is now: " & vbTab & r.Value
            'Mirror this new value.
            Sheet1_Mirror.Range(r.Address).Value = r.Value
        Else
            'It hasn't really changed. Do nothing.
        End If
    Next
End Sub

Ответ 2

Попробуйте этот код. Когда вы вводите диапазон, он сохраняет исходные значения ячейки в объекте словаря. Когда происходит изменение рабочего листа, он сравнивает сохраненные значения с действиями и выделяет любые изменения.
NB: чтобы повысить эффективность эталонных сценариев сценариев Microsoft, заменив As Object на As Scripting.Dictionary и CreateObject ( "Scripting.Dictionary" ) с New Scripting.Dictionary.

Option Explicit

Private previousRange As Object 'reference microsoft scripting runtime & use scripting.dictionary for better performance
                                'I've gone with late binding to avoid references from confusing the example


Private Sub Worksheet_Change(ByVal Target As Range)

    Dim cell As Variant

    For Each cell In Target
        If previousRange.Exists(cell.Address) Then
            If previousRange.Item(cell.Address) <> cell.FormulaR1C1 Then
                cell.Interior.ColorIndex = 36
            End If
        End If
    Next

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim cell As Variant

    Set previousRange = Nothing 'not really needed but I like to kill off old references
    Set previousRange = CreateObject("Scripting.Dictionary")

    For Each cell In Target.Cells
        previousRange.Add cell.Address, cell.FormulaR1C1
    Next

End Sub

пс. любой код vba для обновления ячеек (даже просто цвет) остановит работу excel undo от работы! Чтобы обойти это, вы можете перепрограммировать функциональность отмены, но она может быть достаточно интенсивной. Примеры решений: http://www.jkp-ads.com/Articles/UndoWithVBA00.asp/http://www.j-walk.com/ss/excel/tips/tip23.htm

Ответ 3

Этот код использует комментарии для хранения предыдущего значения (обратите внимание, если вам нужны комментарии для других целей, этот метод удалит их)

Ячейки, которые не имеют значения, имеют цвет reset до xlNone
Целое значение, введенное в ячейку, является синим (ColorIndex 34)
Если значение изменено, ячейка переходит от синего цвета к желтому.

Обычный модуль - отключить отображение комментариев

    Sub SetCom()
      Application.DisplayCommentIndicator = xlNoIndicator
    End Sub

Листовой код для внесения изменений

    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng1 As Range
    Dim shCmt As Comment
    For Each rng1 In Target.Cells

    If Len(rng1.Value) = 0 Then
    rng1.Interior.ColorIndex = xlNone
    On Error Resume Next
    rng1.Comment.Delete
    On Error GoTo 0
    Else

    On Error Resume Next
    Set shCmt = rng1.Comment
    On Error GoTo 0

    If shCmt Is Nothing Then
        Set shCmt = rng1.AddComment
        shCmt.Text Text:=CStr(rng1.Value)
         rng1.Interior.ColorIndex = 34
    Else
        If shCmt.Text <> rng1.Value Then
            rng1.Interior.ColorIndex = 36
            shCmt.Text Text:=CStr(rng1.Value)
        End If
    End If
    End If
    Next
    End Sub

Ответ 4

Я знаю, что это старый поток, но у меня была такая же проблема: "Смените ячейку A1, и ячейка подсвечивается. Это то, что я ожидаю. Дважды щелкните B1, но не меняйте значение там, а затем щелкните C1. Вы заметите, что B1 подсвечивается!"

Я не хотел выделять ячейку, если она была только двойным щелчком без значения внутри.

Я решил легко. Возможно, это поможет кому-то в будущем.

Я только что добавил это в начале события:

 If Target.Value = "" Then
      Exit Sub
 End If