Acompanhe as mudanças na célula A1 na célula B1 Celular A2 na célula B2 e assim por diante

0

Eu preciso acompanhar as alterações da célula A1 na célula A2 da célula B1 na célula B2 e assim por diante ....

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

e assim por diante .. Os valores da coluna A serão dados manualmente por mim com base no meu requisito no formato de data (mm / dd / aaaa).

O mesmo com A2 & B2 A3 & B3 & Então, em.

    
por Harish Reddy 13.09.2017 / 23:08

1 resposta

0

O código abaixo deve funcionar, basta adicioná-lo ao código VBA para a planilha onde você insere todos os dados. Existem algumas coisas que você precisará configurar

  • Uma nova planilha chamada "Dados"
  • Nesta nova planilha, você precisará adicionar colunas com os títulos HISTA1, HISTA2, HISTA3 etc.
  • Você precisará definir essas colunas como intervalos nomeados com o mesmo nome do cabeçalho que você forneceu (no código, subi para 6 colunas, mas você pode adicionar linhas extras ao código se precisar de mais
  • Para as células B1, B2, B3 etc na folha de registro, você precisará adicionar listas de validação de dados e fazer referência ao intervalo nomeado correto. Por exemplo, na célula B1, o intervalo seria "= 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
    

Eu baseei o código no seu exemplo, mas se as referências da célula forem diferentes, o código precisará ser alterado, pois a linha de entrada está vinculada à coluna do histórico.

Qualquer dúvida ou problema, fico feliz em ajudar.

    
por 15.09.2017 / 22:39