Мне нужно отслеживать изменения ячейки A1 в ячейке B1 ячейки A2 в ячейке B2 и так далее ....

For Ex initially 
Cell A1 & Cell B1 should be Blank
If Cell A1=9/14/2017 & Cell B1 should be having a Drop down with Blank
If Cell A1=9/21/2017 & Cell B1 Should be having a Drop down with 9/14/2017
If Cell A1=9/28/2017 & Cell B1 Should be having a Drop down with 9/14/2017 & 9/21/2017
If Cell A1=10/08/2017 & Cell B1 Should be having a Drop down with 9/14/2017 , 9/21/2017 & 9/28/2017

и так далее.. Значения столбца A будут предоставлены мной вручную в соответствии с моим требованием в формате даты (мм / дд / гггг).

То же самое с A2 & B2 A3 & B3 и так далее.

1 ответ1

0

Приведенный ниже код должен работать, просто добавьте его в код 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
    

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

Любые вопросы или проблемы, рад помочь.

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .