Note: The other languages of the website are Google-translated. Back to English

Как запомнить или сохранить предыдущее значение измененной ячейки в Excel?

Обычно при обновлении ячейки новым содержимым предыдущее значение будет закрыто, если не отменить операцию в Excel. Однако, если вы хотите сохранить предыдущее значение для сравнения с обновленным, сохранение предыдущего значения ячейки в другую ячейку или в комментарий к ячейке будет хорошим выбором. Метод, описанный в этой статье, поможет вам в этом.

Сохранить предыдущее значение ячейки с кодом VBA в Excel


Сохранить предыдущее значение ячейки с кодом VBA в Excel

Предположим, у вас есть таблица, как показано на скриншоте ниже. Если какая-либо ячейка в столбце C изменилась, вы хотите сохранить ее предыдущее значение в соответствующей ячейке столбца G или автоматически сохранить в комментарии. Для этого сделайте следующее.

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

2. В дебюте Microsoft Visual Basic для приложений Скопируйте приведенный ниже код VBA в окно кода.

Следующий код VBA помогает сохранить предыдущее значение ячейки указанного столбца в другой столбец.

Код VBA: сохранить предыдущее значение ячейки в другую ячейку столбца

Dim xRg As Range
Dim xChangeRg As Range
Dim xDependRg As Range
Dim xDic As New Dictionary
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim I As Long
    Dim xCell As Range
    Dim xDCell As Range
    Dim xHeader As String
    Dim xCommText As String
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    xHeader = "Previous value :"
    x = xDic.Keys
    For I = 0 To UBound(xDic.Keys)
        Set xCell = Range(xDic.Keys(I))
        Set xDCell = Cells(xCell.Row, 7)
        xDCell.Value = ""
        xDCell.Value = xDic.Items(I)
    Next
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim I, J As Long
    Dim xRgArea As Range
    On Error GoTo Label1
    If Target.Count > 1 Then Exit Sub
    Application.EnableEvents = False
    Set xDependRg = Target.Dependents
    If xDependRg Is Nothing Then GoTo Label1
    If Not xDependRg Is Nothing Then
        Set xDependRg = Intersect(xDependRg, Range("C:C"))
    End If
Label1:
    Set xRg = Intersect(Target, Range("C:C"))
    If (Not xRg Is Nothing) And (Not xDependRg Is Nothing) Then
        Set xChangeRg = Union(xRg, xDependRg)
    ElseIf (xRg Is Nothing) And (Not xDependRg Is Nothing) Then
        Set xChangeRg = xDependRg
    ElseIf (Not xRg Is Nothing) And (xDependRg Is Nothing) Then
        Set xChangeRg = xRg
    Else
        Application.EnableEvents = True
        Exit Sub
    End If
    xDic.RemoveAll
    For I = 1 To xChangeRg.Areas.Count
        Set xRgArea = xChangeRg.Areas(I)
        For J = 1 To xRgArea.Count
            xDic.Add xRgArea(J).Address, xRgArea(J).Formula
        Next
    Next
    Set xChangeRg = Nothing
    Set xRg = Nothing
    Set xDependRg = Nothing
    Application.EnableEvents = True
End Sub

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

Код VBA: сохранить предыдущее значение ячейки в комментарии

Dim xRg As Range
Dim xChangeRg As Range
Dim xDependRg As Range
Dim xDic As New Dictionary
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim I As Long
    Dim xCell As Range
    Dim xHeader As String
    Dim xCommText As String
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    xHeader = "Previous value :"
    For I = 0 To UBound(xDic.Keys)
        Set xCell = Range(xDic.Keys(I))
        If Not xCell.Comment Is Nothing Then xCell.Comment.Delete
        With xCell
            .AddComment
            .Comment.Visible = False
            .Comment.Text xHeader & vbCrLf & xDic.Items(I)
        End With
    Next
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim I, J As Long
    Dim xRgArea As Range
    On Error GoTo Label1
    If Target.Count > 1 Then Exit Sub
    Application.EnableEvents = False
    Set xDependRg = Target.Dependents
    If xDependRg Is Nothing Then GoTo Label1
    If Not xDependRg Is Nothing Then
        Set xDependRg = Intersect(xDependRg, Range("C:C"))
    End If
Label1:
    Set xRg = Intersect(Target, Range("C:C"))
    If (Not xRg Is Nothing) And (Not xDependRg Is Nothing) Then
        Set xChangeRg = Union(xRg, xDependRg)
    ElseIf (xRg Is Nothing) And (Not xDependRg Is Nothing) Then
        Set xChangeRg = xDependRg
    ElseIf (Not xRg Is Nothing) And (xDependRg Is Nothing) Then
        Set xChangeRg = xRg
    Else
        Application.EnableEvents = True
        Exit Sub
    End If
    xDic.RemoveAll
    For I = 1 To xChangeRg.Areas.Count
        Set xRgArea = xChangeRg.Areas(I)
        For J = 1 To xRgArea.Count
            xDic.Add xRgArea(J).Address, xRgArea(J).Text
        Next
    Next
    Set xChangeRg = Nothing
    Set xRg = Nothing
    Set xDependRg = Nothing
    Application.EnableEvents = True
End Sub

Внимание: В коде цифра 7 указывает столбец G, в который вы сохраните предыдущую ячейку, а C: C - столбец, в котором вы сохраните предыдущее значение ячейки. Пожалуйста, измените их в соответствии с вашими потребностями.

3. Нажмите Инструменты > Рекомендации для открытия Ссылки - VBAProject диалоговое окно, проверьте Среда выполнения сценариев Microsoft поле и, наконец, щелкните OK кнопка. Смотрите скриншот:

4. нажмите другой + Q ключи, чтобы закрыть Microsoft Visual Basic для приложений окно.

С этого момента, когда значение ячейки в столбце C обновляется, предыдущее значение ячейки будет сохранено в соответствующие ячейки в столбце G или будет сохранено в комментариях, как показано на скриншотах ниже.

Сохраните предыдущие значения ячеек в других ячейках:

Сохраните предыдущие значения ячеек в комментариях:


Лучшие инструменты для работы в офисе

Kutools for Excel решает большинство ваших проблем и увеличивает вашу производительность на 80%

  • Снова использовать: Быстро вставить сложные формулы, диаграммы и все, что вы использовали раньше; Зашифровать ячейки с паролем; Создать список рассылки и отправлять электронные письма ...
  • Бар Супер Формулы (легко редактировать несколько строк текста и формул); Макет для чтения (легко читать и редактировать большое количество ячеек); Вставить в отфильтрованный диапазон...
  • Объединить ячейки / строки / столбцы без потери данных; Разделить содержимое ячеек; Объединить повторяющиеся строки / столбцы... Предотвращение дублирования ячеек; Сравнить диапазоны...
  • Выберите Дубликат или Уникальный Ряды; Выбрать пустые строки (все ячейки пустые); Супер находка и нечеткая находка во многих рабочих тетрадях; Случайный выбор ...
  • Точная копия Несколько ячеек без изменения ссылки на формулу; Автоматическое создание ссылок на несколько листов; Вставить пули, Флажки и многое другое ...
  • Извлечь текст, Добавить текст, Удалить по позиции, Удалить пробел; Создание и печать промежуточных итогов по страницам; Преобразование содержимого ячеек в комментарии...
  • Суперфильтр (сохранять и применять схемы фильтров к другим листам); Расширенная сортировка по месяцам / неделям / дням, периодичности и др .; Специальный фильтр жирным, курсивом ...
  • Комбинируйте книги и рабочие листы; Объединить таблицы на основе ключевых столбцов; Разделить данные на несколько листов; Пакетное преобразование xls, xlsx и PDF...
  • Более 300 мощных функций. Поддерживает Office/Excel 2007-2021 и 365. Поддерживает все языки. Простое развертывание на вашем предприятии или в организации. Полнофункциональная 30-дневная бесплатная пробная версия. 60-дневная гарантия возврата денег.
вкладка kte 201905

Вкладка Office: интерфейс с вкладками в Office и упрощение работы

  • Включение редактирования и чтения с вкладками в Word, Excel, PowerPoint, Издатель, доступ, Visio и проект.
  • Открывайте и создавайте несколько документов на новых вкладках одного окна, а не в новых окнах.
  • Повышает вашу продуктивность на 50% и сокращает количество щелчков мышью на сотни каждый день!
офисный дно
Сортировать комментарии по
Комментарии (20)
Оценок пока нет. Оцените первым!
Этот комментарий был сведен к минимуму модератором на сайте
мне нужно что-то вроде этого, но только в определенных ячейках (например: G12, чтобы показать в H23 старое значение)
Этот комментарий был сведен к минимуму модератором на сайте
И другое... Мне нужен этот запуск, когда ячейка изменяется по результату (пример: A1 + B1 = C1... если я меняю значение A или B, скрипт не работает - в ячейке G ничего не происходит)
Этот комментарий был сведен к минимуму модератором на сайте
Привет ! Я просто хотел знать, можно ли регистрировать кратные изменения в ячейке, я имею в виду, если я помещаю данные в ячейку C2, а затем меняю эти данные на другую информацию, предыдущие данные передаются в ячейку G2 (как в этом посте ), но если я еще раз изменю значение в ячейке C2, второе изменение, которое я сделал, перейдет в ячейку H2 (например), и теперь я записал информацию о 3 движениях, которые я понял, и делаю это почти 5 раз больше (сохранить предыдущее значение ячейки 5 раз). Если бы вы могли мне помочь, я был бы очень признателен, потому что здесь, в вашем посте, это единственное место, которое я нашел, где частично решить мою проблему. Спасибо, что поделились этим контентом!!!!
Этот комментарий был сведен к минимуму модератором на сайте
ты нашел как это сделать?
Этот комментарий был сведен к минимуму модератором на сайте
Я думал об этом в предложении «Если/иначе», но я новичок в использовании VBA, поэтому, если у вас есть другой пост, который мог бы мне помочь, поделитесь со мной, и еще раз спасибо! продолжайте делиться знаниями
Этот комментарий был сведен к минимуму модератором на сайте
Почему приведенный выше код не работает для данных DDE, у меня есть данные в столбце, который изменяется через dde, но в тот момент, когда я применил этот код для сохранения предыдущего значения этого столбца в другой столбец, он ничего не делает;

Любая помощь для достижения этого очень ценится.
Этот комментарий был сведен к минимуму модератором на сайте
Здравствуй !

Отличная функция, но как ее изменить, чтобы она работала также с ячейкой, которую я хочу запомнить значение, содержащее ВПР? К сожалению, я не смог найти, что изменить, чтобы сохранить значение из ВПР. Как бы то ни было, это не работает, когда ВПР находится посередине :(

Заранее спасибо за вашу помощь !
Этот комментарий был сведен к минимуму модератором на сайте
Здравствуйте, поэтому изменили код «Код VBA: сохранить предыдущее значение ячейки в другую ячейку столбца», который вы сделали, однако у меня есть пара вопросов:

1. Как код узнает, какой столбец имеет новые значения? (который после другого обновления будет иметь свои значения в другом столбце)
2. Как вы можете превратить это в макрос? Или сделайте так, чтобы он запускался автоматически, когда другая программа вызывает файл xlsm. файл?

Спасибо
Этот комментарий был сведен к минимуму модератором на сайте
Это для одного значения ячейки, но как сделать для нескольких значений ячеек, я хочу хранить и обновлять данные 4 ячеек, например, данные ячеек C, D, E, F в ячейку G, H, I, J соответственно, как это сделать пожалуйста помоги
Этот комментарий был сведен к минимуму модератором на сайте
Если ячейка, которую я хочу сохранить, представляет собой формулу, ячейка G сохранит только формулу и рассчитает значение. Мне нужно сохранить значение, а не формулу. Как я могу сказать коду VBA, что значение изменяется, хотя формула не изменяется. С уважением Флемминг Полезно Бесполезно
Этот комментарий был сведен к минимуму модератором на сайте
Есть ли способ повторить это для всех изменений? Я хотел бы, чтобы в поле комментариев отображались все предыдущие записи, если это возможно.
Этот комментарий был сведен к минимуму модератором на сайте
Привет Дженни! Вам удалось решить эту проблему? Я также пытаюсь собрать в поле для комментариев все новые записи, но у меня возникают трудности с адаптацией кода VBA к этому. Благодарю вас!
Этот комментарий был сведен к минимуму модератором на сайте
Это хорошо, если вы вводите. Можете ли вы помочь мне работать с ним, когда данные вводятся с использованием значения функции из DDE (динамический обмен данными)?
Этот комментарий был сведен к минимуму модератором на сайте
Здравствуйте,
Извините, я не могу решить эту проблему. Я предлагаю вам опубликовать проблему на форуме ниже, чтобы получить помощь от других энтузиастов Excel.
https://www.extendoffice.com/forum/kutools-for-excel.html
Этот комментарий был сведен к минимуму модератором на сайте
cho e hỏi chút la có cách nào để khi tính toán cộng trừ xong thì nó sẽ lưu lại giá trị khi tính toán xong khong ạ
ви ду:
Giá trị ở cột A = cột B + cột C
Khi tính toán xong cột a sẽ lưu giá trị sau khi đ tính toán xong, lần tiếp theo tính toán thì nó cột a sẽy giá hiện tạ ể tínhun tiếp chứ hông
Этот комментарий был сведен к минимуму модератором на сайте
Привет Трунг,
Код обновлен. Пожалуйста, попробуйте. Спасибо за ваш отзыв.
В следующем коде число 5 в этой строке Установите xDCell = Cells (xCell.Row, 5) представляет столбец E, в который вы поместите предыдущее значение. A:A относится к ячейкам в столбце A. Вам нужно сохранить предыдущие значения этих ячеек.

Dim xRg As Range
'Updated by Extendoffice 20220803
Dim xChangeRg As Range
Dim xDependRg As Range
Dim xDic As New Dictionary
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim I As Long
    Dim xCell As Range
    Dim xDCell As Range
    Dim xHeader As String
    Dim xCommText As String
    Dim X
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    xHeader = "Previous value :"
    X = xDic.Keys
    For I = 0 To UBound(xDic.Keys)
        Set xCell = Range(xDic.Keys(I))
        Set xDCell = Cells(xCell.Row, 5)
        
        xDCell.NumberFormatLocal = xCell.NumberFormatLocal
        xDCell.Value = xDic.Items(I)
        
    Next
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim I, J As Long
    Dim xRgArea As Range
    On Error GoTo Label1
    If Target.Count > 1 Then Exit Sub
    Application.EnableEvents = False
    Set xDependRg = Target.Dependents
    If xDependRg Is Nothing Then GoTo Label1
    If Not xDependRg Is Nothing Then
        Set xDependRg = Intersect(xDependRg, Range("A:A"))
    End If
Label1:
    Set xRg = Intersect(Target, Range("A:A"))
    If (Not xRg Is Nothing) And (Not xDependRg Is Nothing) Then
        Set xChangeRg = Union(xRg, xDependRg)
    ElseIf (xRg Is Nothing) And (Not xDependRg Is Nothing) Then
        Set xChangeRg = xDependRg
    ElseIf (Not xRg Is Nothing) And (xDependRg Is Nothing) Then
        Set xChangeRg = xRg
    Else
        Application.EnableEvents = True
        Exit Sub
    End If
    xDic.RemoveAll
    For I = 1 To xChangeRg.Areas.Count
        Set xRgArea = xChangeRg.Areas(I)
        For J = 1 To xRgArea.Count
            xDic.Add xRgArea(J).Address, xRgArea(J).Text ' xRgArea(J).Formula
        Next
    Next
    Set xChangeRg = Nothing
    Set xRg = Nothing
    Set xDependRg = Nothing
    Application.EnableEvents = True
End Sub
Этот комментарий был сведен к минимуму модератором на сайте
работает только при вводе данных вручную
но не работает, когда данные обновляются с веб-сайта
пожалуйста, помогите
благодаря
Этот комментарий был сведен к минимуму модератором на сайте
сохранение предыдущих данных при вводе вручную, но не работает при обновлении данных с веб-сайта, ничего не делает
пожалуйста, помогите
благодаря
Этот комментарий был сведен к минимуму модератором на сайте
Привет Камаль.
Эта проблема немного сложна. Перепробовав разные методы, я не могу с этим справиться. Я прошу прощения за это.
Этот комментарий был сведен к минимуму модератором на сайте
Может ли кто-нибудь помочь в этой проблеме
Здесь еще нет комментариев
Оставляйте свои комментарии
Публикация как гость
×
Оценить этот пост:
0   Характеристики
Предлагаемые места

Подписывайтесь на Нас

Copyright © 2009 - www.extendoffice.ком. | Все права защищены. Питаться от ExtendOffice, | Карта сайта
Microsoft и логотип Office являются товарными знаками или зарегистрированными товарными знаками Microsoft Corporation в США и / или других странах.
Защищено Sectigo SSL