Приведенный ниже код должен работать, просто добавьте его в код VBA для листа, в который вы вводите все данные. Есть несколько вещей, которые вам нужно будет настроить
- Новый лист под названием "Данные"
- В этом новом листе вам нужно будет добавить столбцы с заголовками HISTA1, HISTA2, HISTA3 и т.д.
- Затем вам нужно будет определить эти столбцы как именованные диапазоны с тем же именем, что и заголовок, который вы им дали (в коде я поднялся до 6 столбцов, но вы можете добавить дополнительные строки в код, если вам нужно больше
Для ячеек B1, B2, B3 и т.д. В листе ввода необходимо добавить списки проверки данных и указать правильный именованный диапазон. Например, в ячейке B1 диапазон будет "= HISTA1"
Private Sub Worksheet_Change(ByVal Target As Range)
Dim a, b, c, d, e, f, x, newval, hist As Long
Dim data As Worksheet
Set data = ThisWorkbook.Worksheets("Data")
Set ws = ThisWorkbook.ActiveSheet
If Intersect(Target, Range("A:A")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
x = Target.Row
newval = Target.Value
Application.EnableEvents = False
Application.Undo
hist = Target.Value
y = data.Cells(Rows.Count, x).End(xlUp).Row
data.Cells(y + 1, x).Value = hist
Target.Value = newval
a = data.Range("A" & Rows.Count).End(xlUp).Row
b = data.Range("B" & Rows.Count).End(xlUp).Row
c = data.Range("C" & Rows.Count).End(xlUp).Row
d = data.Range("D" & Rows.Count).End(xlUp).Row
e = data.Range("E" & Rows.Count).End(xlUp).Row
f = data.Range("F" & Rows.Count).End(xlUp).Row
ActiveWorkbook.Names("HISTA1").Delete
ActiveWorkbook.Names("HISTA2").Delete
ActiveWorkbook.Names("HISTA3").Delete
ActiveWorkbook.Names("HISTA4").Delete
ActiveWorkbook.Names("HISTA5").Delete
ActiveWorkbook.Names("HISTA6").Delete
ActiveWorkbook.Names.Add Name:="HISTA1", RefersTo:="=Data!$A$2:$A$" & a
ActiveWorkbook.Names.Add Name:="HISTA2", RefersTo:="=Data!$B$2:$B$" & b
ActiveWorkbook.Names.Add Name:="HISTA3", RefersTo:="=Data!$C$2:$C$" & c
ActiveWorkbook.Names.Add Name:="HISTA4", RefersTo:="=Data!$D$2:$D$" & d
ActiveWorkbook.Names.Add Name:="HISTA5", RefersTo:="=Data!$E$2:$E$" & e
ActiveWorkbook.Names.Add Name:="HISTA6", RefersTo:="=Data!$F$2:$F$" & f
Application.EnableEvents = True
End Sub
Я основал код на вашем примере, но если ссылки на ячейки отличаются, код необходимо будет изменить, поскольку строка ввода связана со столбцом истории.
Любые вопросы или проблемы, рад помочь.