• Revista PROGRAMAR: Já está disponível a edição #53 da revista programar. Faz já o download aqui!

milupax

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

9 mensagens neste tópico

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 ...  :hmm:

Saudações!  :)

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

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

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Amigo MetalFatigue, funcionou perfeitamente!  :cheesygrin:

Obrigadíssimo!  :cheers:

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

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

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

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

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

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:

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

É 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.

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

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:

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

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.

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Crie uma conta ou ligue-se para comentar

Só membros podem comentar

Criar nova conta

Registe para ter uma conta na nossa comunidade. É fácil!


Registar nova conta

Entra

Já tem conta? Inicie sessão aqui.


Entrar Agora