Jump to content
Sign in to follow this  
milupax

[Ajuda] Copiar valor para a última célula condicionalmente

Recommended Posts

milupax

Olá pessoal! Um bem haja a todos!

Precisava de uma ajudinha, suponho que fácil, mas como percebo pouco disto, ando aqui às aranhas ...

Tenho aqui um código que utilizo para copiar o valor duma célula (que está constantemente a ser actualizada por valor vindo fora do excel) para a última célula vazia da coluna, como um registo de dados, segundo a segundo.

O código é

Application.ScreenUpdating = False

    Sheets("Data").Select

    Range("A1").Select

    Selection.Copy

    Cells(65536, 1).End(xlUp).Offset(1, 0).Activate

    ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _

        IconFileName:=False

    Range("A1").Select

    Sheets("Graphs").Select

Application.ScreenUpdating = True

O que eu precisava é que ele fizesse isso só se o valor actualizado fosse diferente do último.

E atenção, precisava que estivesse sempre a fazer isso e não uma vez e parar.

Ou seja, copiar sempre que o valor actualizado fôr diferente do ultimo valor, sempre em rotina.

Provavelmente, acrescentando código condicional comparando a célula A1 com a última ocupada, mas ando aqui em tentativas e não chego a lado nenhum ...  🤔

Saudações!  :)

Share this post


Link to post
Share on other sites
MetalFatigue

Não percebi bem o que queres dizer com rotina, mas basta fazeres esta modificação para funcionar:

Application.ScreenUpdating = False

    Sheets("Data").Select
    Range("A1").Select
    Selection.Copy
    Cells(65536, 1).End(xlUp).Offset(1, 0).Activate
if(activecell.offset(-1,0).value<>range("A1").value)then
    ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
        IconFileName:=False
    Range("A1").Select
    Sheets("Graphs").Select
end if
Application.ScreenUpdating = True

cumprimentos

Share this post


Link to post
Share on other sites
milupax

Olá a todos!

Precisava de  ajuda parecida com a de cima, mas em vez de ser apenas numa célula (A1)  necessito que vise um range de células (por exemplo A1:F1) em que só active o offset se o valor de cada célula individualmente seja diferente de 0 (""), mas que o offset seja activado apenas e só nessa coluna.

Percebo pouco disto, ando aqui à voltas e não consigo adaptar o código de cima, o que deve ser simples para quem percebe disto ...  :)

Obrigado desde já pela atenção dispensada!

Cumprimentos

Share this post


Link to post
Share on other sites
MetalFatigue

Mais uma vez não entendi exactamente o teu problema, mas acho que estás com dificuldade é em averiguar as celulas do range e fazer um offset se determinada condição existir numa dessas celulas. Isto vai te ajudar:

        Dim celula As Range
        Dim vazio As Boolean
        Application.ScreenUpdating = False
        Range("A1:F1").Select
        For Each celula In Selection
            If (celula.Value = "") Then
                vazio = True
                Exit For
            End If
        Next
        If (vazio) Then
            'Colocar aqui código se alguma celula foi encontrada vazia
        Else 'Se nunhuma das celulas estiver vazia no range, passa para linha seguinte
            Selection.Offset(1, 0).Select
        End If

Share this post


Link to post
Share on other sites
milupax

Bom antes de mais muito obrigado pela sugestão, MetalFatigue!  ;)

Penso que não é exactamente isso que preciso, mas penso que posso aproveitar, ainda não tive tempo para ver com calma ...

O que preciso é do seguinte:

          A      B    C

1

2

3

A linha 1 está ligada para fora do excel via web query.

Então aparece em B1  um valor e a macro faz o copypaste offset para B2:

          A      B          C

1            milupax

2            milupax

3

Depois, passados uns segundos, aparece um outro valor em A1,

e eu preciso que ele me envie não para A3, o End(xlUp).Offset(1, 0) do range, mas que considere cada coluna individualmente, ou seja, que envie o valor para A2, a célula imediatamente vazia da coluna:

              A                      B                C

1    MetalFatigue       

2    MetalFatigue      milupax

3

(Se fossem duas ou três colunas eu podia fazer toscamente código separadamente para cada coluna, só que sendo dezenas ...  :P

Cumprimentos e abraço  :cheers:

Share this post


Link to post
Share on other sites
MetalFatigue

É preciso fazeres algo do género:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("1:1")) Is Nothing Then
        Dim celula As Range
        Application.ScreenUpdating = False
        Range("1:1").Select
        For Each celula In Selection
            If (celula.Value <> "") Then
                Call CopiarValorUltimaLinha(celula)
            End If
        Next
    End If
End Sub

Private Sub CopiarValorUltimaLinha(celula As Range)
    Dim ultimaLinha As Long
    ultimaLinha = Range("A:A").Count
    
    Cells(ultimaLinha, celula.Column).End(xlUp).Select
    If Selection.Row = 1 Then
        Selection.Offset(1, 0).Value = celula.Value
    End If
End Sub

Não sei a que momentos fazes o update dessa linha. Eu coloquei na folha1 cada vez que altera algo na folha (evento change) ele vai ver se é preciso mudar.

Se alteração na folha não for na linha 1, então não faz nada (intersect). Verifica em toda a linha onde estão valores e chama o procedimento (quando encontra dados) para copiar para a última linha vaga.

Share this post


Link to post
Share on other sites
milupax

Boas, MetalFatigue!

Bom, confesso que não gosto muito do "evento change", no passado sempre que utilizei de vez em quando provocava o crash do Excel (2007). Agora fui experimentar e assim foi ...

Mas em relação ao código funciona lindamente! Só tive que alterar a parte final e incluir a parte de código,

  Cells(ultimaLinha, celula.Column).End(xlUp).Select

dentro da condição:

    If  Selection.Row = 1 Then
        Cells(ultimaLinha, celula.Column).End(xlUp).Select
        Selection.Offset(1, 0).Value = celula.Value 

pois, de outro modo, só me faz offset para a linha 2, ou seja, não actualiza os novos valores para linhas 3,4,5,etc. 

Mais uma vez, obrigadíssimo pela ajuda!  :D   :cheers:

Share this post


Link to post
Share on other sites
MetalFatigue

Por acaso alterei aí uma coisa e acabei por deixar mal. Esse If nem é necessário. Por isso é que estava mal. Inicialmente isso tinha if e else, mas depois vi que era desnecessário e acabei por deixar ficar mal, não apagando o if todo  :D

Podes tirar esse if a vontade fica só as linhas que estão no interior.

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
Sign in to follow this  

×
×
  • Create New...

Important Information

By using this site you accept our Terms of Use and Privacy Policy. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.