Excel Macro pra copiar a linha em que o comentário está sendo feito

[Scofieldgyn]

Olá pessoas, preciso de uma ajuda.

 

A explicação está no próprio arquivo, lá tem os detalhes do que eu preciso.

 

A primeira aba não está em formato de tabela dinâmica, porq eu retirei o formato porq se tratar de dados verídicos daqui da empresa, mas imaginem como se fosse.

 

Ajuda.zip

[Midori]

@Scofieldgyn Já tentou aplicar a macro no evento Change? Assim é só copiar os dados da linha para a última da outra planilha.

[Scofieldgyn]

@Midori Preciso justamente do código pelo evento change e sendo bem sincero, não tenho experiência com isso.

 

acredito que não será um simples código só copiar e colar, pois é necessário realizar algumas validações, ou seja, verificar a última linha preenchida da tabela dinâmica para que o evento só ocorra nessa limitação e depois verificar se está repetido na outra guia e substituir pelo novo comentário que usuário fizer.

[Midori]

@Scofieldgyn Se o código é único a macro pode procurar na planilha Comentário se já foi acrescentado. Veja se assim resolve,

 

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count = 1 Then
        If Not Application.Intersect(Target, [O:O]) Is Nothing Then
            Call AtualizaComentario(Target.Offset(0, -12), Target)
        End If
    End If
End Sub

 

Sub AtualizaComentario(Codigo As Range, ByVal Comentario As String)
    Dim PlanCom     As Worksheet
    Dim PlanDin     As Worksheet
    Dim BuscaLinha  As Range
    
    Set PlanCom = ThisWorkbook.Sheets("Comentários")
    Set PlanDin = ThisWorkbook.Sheets("Tabela Dinâmica")
    Set BuscaLinha = PlanCom.[B:B].Find( _
        What:=Codigo.Value, LookIn:=xlValues, LookAt:=xlWhole)
    
    If Not BuscaLinha Is Nothing Then
        BuscaLinha(1, 13) = Comentario
    Else
        Set BuscaLinha = PlanCom.[A1].Offset( _
            [A:A].Rows.Count - 1).End(xlUp).Offset(1)
        BuscaLinha.Resize(1, 14).Value = _
            Codigo.Offset(0, -1).Resize(1, 14).Value
    End If
End Sub

 

[Scofieldgyn]

@Midori A princípio resolveu por parte, o código do produto vai repetir ínumeras vezes, porém ele terá validade e unidade de depósito variáveis.

 

É possível fazer essa amarração nas 3 dimensões? assim evitará de substituir quando a data de validade e unidade de depósito for diferente.

 

[Midori]

@Scofieldgyn Nesse caso a macro pode tentar filtrar os dados na planilha Comentários. Aí o critério pode ser o código, data e unidade para atualizar caso encontre algum resultado. Outra alternativa mais lenta é com um loop que pode verificar cada linha da tabela até encontrar os três resultados.

[Scofieldgyn]

@Midori talvez a melhor forma seria o loop.

 

Mas assim, imaginemos que se encontrasse o mesmo código, validade e unidade, ele só substituiria o comentario, não precisaria substituir todo o texto da linha, não sei o quanto isso melhoraria na perfomance.

 

 

[Midori]

@Scofieldgyn Com loop fica assim,

 

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count = 1 Then
        If Not Application.Intersect(Target, [O:O]) Is Nothing Then
            Call AtualizaComentario( _
                Target.Offset(0, -12), _
                Target.Offset(0, -13), _
                Target.Offset(0, -10), _
                Target)
        End If
    End If
End Sub

 

Sub AtualizaComentario( _
    ByVal Codigo As String, _
    ByVal Unidade As String, _
    ByVal Data As Date, _
    Comentario As Range _
)
    Dim Celula      As Range
    Dim Cadastrado  As Boolean
    
    Set Celula = ThisWorkbook.Sheets("Comentários").[A3]
    
    Do While Celula <> ""
        If Celula.Value = Unidade _
        And Celula(1, 2).Value = Codigo _
        And Celula(1, 4).Value = Data Then
            Cadastrado = True
            Celula(1, 14).Value = Comentario.Value
            Exit Do
        End If
        Set Celula = Celula(2)
    Loop
    
    If Not Cadastrado Then
        Celula.Resize(1, 14).Value = _
            Comentario.Offset(0, -13).Resize(1, 14).Value
    End If
End Sub