Ir ao conteúdo
  • Cadastre-se
alexassa

Excel mudar conteudo para baixo quando chegar determinada data

Posts recomendados

Obrigado pessoal.

mais uma duvida.

tenho uma lista de funcionários e gostaria de organizar ela tipo. conforme um funcionário pede demissão eu colocaria a data da demissão e quando chegar esta data automaticamente ir para baixo da lista.

saida.jpg.8639eb380431d8a9f7e4528d60cb9e55.jpg

Compartilhar este post


Link para o post
Compartilhar em outros sites

Salve Galera... Alguma Ideia??

Compartilhar este post


Link para o post
Compartilhar em outros sites

 

Disponibilize o seu arquivo Excel com exemplos. Imagens não servem.

  • Curtir 1

Compartilhar este post


Link para o post
Compartilhar em outros sites

 

Instale uma cópia do código abaixo no módulo de EstaPasta_de_trabalho.

Private Sub Workbook_Open()
 Dim k As Long
  With Sheets("Sheet1")
   For k = .Cells(Rows.Count, 4).End(3).Row To 2 Step -1
    If .Cells(k, 4) <> "" And .Cells(k, 4) <= Date Then
     .Cells(k, 2).Resize(, 3).Cut .Cells(Rows.Count, 2).End(3)(2)
     .Cells(k, 2).Resize(, 3).Delete
    End If
   Next k
  End With
End Sub

Para testar salve o arquivo habilitado para macros, feche e reabra.

  • Curtir 1

Compartilhar este post


Link para o post
Compartilhar em outros sites

@osvaldomp cara tentei salvar o código ,,mas da um erro e nao salva,, meu pc esta em japonês e nao sei qual e o erro,,

parece que ele pede o arquivo que tem a macro...

Compartilhar este post


Link para o post
Compartilhar em outros sites

Sim, isso foi o que comentei no post #5 ~~~> "Para testar salve o arquivo habilitado para macros, feche e reabra."

  • Curtir 1

Compartilhar este post


Link para o post
Compartilhar em outros sites

@osvaldomp deu certo,, tive que fazer um arquivo novo.

como faço para ele mudar todas as informação que estiver na coluna?

 

Compartilhar este post


Link para o post
Compartilhar em outros sites
4 minutos atrás, alexassa disse:

 

como faço para ele mudar todas as informação que estiver na coluna?

 

 

É facinho. 😉

Basta você dizer a ele "de onde tirar" e "para onde levar" as informações que você quer mudar. 😷

Compartilhar este post


Link para o post
Compartilhar em outros sites

@osvaldomp da uma ajuda... tentei mudar o código mas da erro ...:(

Compartilhar este post


Link para o post
Compartilhar em outros sites

 

Em 06/04/2020 às 22:29, alexassa disse:

 

como faço para ele mudar todas as informação que estiver na coluna?

 

 

Com base no que você escreveu aí acima eu não consigo entender o que você quer ... 😕😷

 

Eu baixei o arquivo do post #10 e também lá não encontrei qualquer explicação do que você quer fazer e nem exemplos do resultado desejado.

Compartilhar este post


Link para o post
Compartilhar em outros sites
2 horas atrás, alexassa disse:

 ...da uma olhada agora.;

 

"quando chegar esta data mover todo o conteudo da cedula para baixo conteudo da cedula futuramente pode aumentar"

 

 

Me parece que o seu tradutor Japonês X Português é xing ling. 🤪

O código abaixo é um "chute" pois tenho dificuldade pra entender o que você quer. Testaí ...

 

Instale uma cópia do código abaixo no lugar do anterior. Adicionei um comando que utiliza W1 como célula auxiliar para evitar que o código rode sem necessidade se for aberto mais de uma vez no mesmo dia. Então, após testar o código remova o apóstrofo inicial da terceira linha do código para ativar aquele comando.

Private Sub Workbook_Open()
 Dim k As Long
  'If [W1] < Date Then [W1] = Date Else: Exit Sub
  With Sheets("Sheet1")
   For k = .Cells(Rows.Count, 4).End(3).Row To 2 Step -1
    If .Cells(k, 4) <> "" And .Cells(k, 4) <= Date Then
     .Cells(k, 2).Resize(, .Cells(k, Columns.Count).End(1).Column - 1).Cut .Cells(Rows.Count, 2).End(3)(2)
     .Cells(k, 2).Resize(, .Cells(.Cells(Rows.Count, 4).End(3).Row, Columns.Count).End(1).Column - 1).Delete
    End If
   Next k
  End With
End Sub

 

  • Curtir 1
  • Haha 1

Compartilhar este post


Link para o post
Compartilhar em outros sites

@osvaldomp Obrigado, ficou perfeito

 

adicionado 26 minutos depois

@osvaldomp Cara, deu e nao deu certo kkkkk

tentei mexer no código mas nao deu certo,, nao entendo nada kkkkk

este arquivo seria o completo com informação dentro, se puder me ajudar,Obrigado.

Conpleto.xlsx

  • Curtir 1

Compartilhar este post


Link para o post
Compartilhar em outros sites

Por favor,kkkkk

Compartilhar este post


Link para o post
Compartilhar em outros sites

 

1 hora atrás, alexassa disse:

Por favor,kkkkk

 

Em 09/04/2020 às 14:07, alexassa disse:
adicionado 26 minutos depois

@osvaldomp Cara, deu e nao deu certo kkkkk

 

 

eu não tinha visto que você editou a mensagem do post #15 ... kkkkk

no arquivo do post #15 não encontrei qualquer código ... kkkkkk

qual foi o código que "fez que deu mas não deu" ?  ... kkkkkk

 

E informe com exatidão qual foi o resultado ao abrir o arquivo e qual é o resultado desejado.

Compartilhar este post


Link para o post
Compartilhar em outros sites

@osvaldomp

este aqui que você mandou.

 

Em 09/04/2020 às 12:01, osvaldomp disse:

 

 

 

Instale uma cópia do código abaixo no lugar do anterior. Adicionei um comando que utiliza W1 como célula auxiliar para evitar que o código rode sem necessidade se for aberto mais de uma vez no mesmo dia. Então, após testar o código remova o apóstrofo inicial da terceira linha do código para ativar aquele comando.


Private Sub Workbook_Open()
 Dim k As Long
  'If [W1] < Date Then [W1] = Date Else: Exit Sub
  With Sheets("Sheet1")
   For k = .Cells(Rows.Count, 4).End(3).Row To 2 Step -1
    If .Cells(k, 4) <> "" And .Cells(k, 4) <= Date Then
     .Cells(k, 2).Resize(, .Cells(k, Columns.Count).End(1).Column - 1).Cut .Cells(Rows.Count, 2).End(3)(2)
     .Cells(k, 2).Resize(, .Cells(.Cells(Rows.Count, 4).End(3).Row, Columns.Count).End(1).Column - 1).Delete
    End If
   Next k
  End With
End Sub

usei este aqui

 

Compartilhar este post


Link para o post
Compartilhar em outros sites
56 minutos atrás, osvaldomp disse:

E informe com exatidão qual foi o resultado ao abrir o arquivo e qual é o resultado desejado.

 

 

Você leu ?

Compartilhar este post


Link para o post
Compartilhar em outros sites

 

Em 10/04/2020 às 00:01, osvaldomp disse:

 

 


Private Sub Workbook_Open()
 Dim k As Long
  'If [W1] < Date Then [W1] = Date Else: Exit Sub
  With Sheets("在留確認")
   For k = .Cells(Rows.Count, 5).End(3).Row To 2 Step -1
    If .Cells(k, 5) <> "" And .Cells(k, 5) <= Date Then
     .Cells(k, 2).Resize(, .Cells(k, Columns.Count).End(1).Column - 1).Cut .Cells(Rows.Count, 2).End(3)(2)
     .Cells(k, 2).Resize(, .Cells(.Cells(Rows.Count, 4).End(3).Row, Columns.Count).End(1).Column - 1).Delete
    End If
   Next k
  End With
End Sub

 

 

estou usando este código.

como a imagem que estou mandando ele nao mudo todo o conteúdo para baixo.

macro.png

Completo.xlsx

Compartilhar este post


Link para o post
Compartilhar em outros sites
Private Sub Workbook_Open()
 Dim k As Long
  'If [W1] < Date Then [W1] = Date Else: Exit Sub
  With Sheets("在留確認")
   For k = .Cells(Rows.Count, 5).End(3).Row To 2 Step -1
    If .Cells(k, 5) <> "" And .Cells(k, 5) <= Date Then
     .Cells(k, 2).Resize(, .Cells(k, Columns.Count).End(1).Column - 1).Cut .Cells(Rows.Count, 2).End(3)(2)
     .Cells(k, 2).Resize(, .Cells(.Cells(Rows.Count, 4).End(3).Row, Columns.Count).End(1).Column - 1).Delete
    End If
   Next k
  End With
End Sub

estou usando este código.

como a imagem que estou mandando ele nao mudo todo o conteúdo para baixo.

macro.png

Completo.xlsx

Compartilhar este post


Link para o post
Compartilhar em outros sites

estou tentando postar mas esta ficando oculto o post, porque será?

adicionado 1 minuto depois

estou usando este código.

como a imagem que estou mandando ele nao mudo todo o conteúdo para baixo.

Private Sub Workbook_Open()
 Dim k As Long
  'If [W1] < Date Then [W1] = Date Else: Exit Sub
  With Sheets("在留確認")
   For k = .Cells(Rows.Count, 5).End(3).Row To 2 Step -1
    If .Cells(k, 5) <> "" And .Cells(k, 5) <= Date Then
     .Cells(k, 2).Resize(, .Cells(k, Columns.Count).End(1).Column - 1).Cut .Cells(Rows.Count, 2).End(3)(2)
     .Cells(k, 2).Resize(, .Cells(.Cells(Rows.Count, 4).End(3).Row, Columns.Count).End(1).Column - 1).Delete
    End If
   Next k
  End With
End Sub

 

macro.png

Compartilhar este post


Link para o post
Compartilhar em outros sites

 

Nos arquivos anteriores a data a ser buscada estava na coluna D, porém nesse último arquivo você colocou uma observação na planilha (figura abaixo) que é para buscar na coluna E, é isso? Se sim, então altere conforme em vermelho abaixo.

For k = .Cells(Rows.Count, 4).End(3).Row To 2 Step -1 ~~~> busca a data na coluna D

For k = .Cells(Rows.Count, 5).End(3).Row To 2 Step -1 ~~~> busca a data na coluna E

 

Sobre deixar linhas vazias eu não sei fazer, sorry. Você pode inserir as linhas manualmente onde desejar.

image.png.2ea7ed34f95b8b15f77151e2032e17a8.png

 

Compartilhar este post


Link para o post
Compartilhar em outros sites

@osvaldomp sim eu mudei no código de 4 para 5 mas nao deu certo.nao seu se viu a foto que postei aqui,, nao esta movendo tudo para baixo.

Compartilhar este post


Link para o post
Compartilhar em outros sites

Pelas fotos eu não consegui entender.

Conforme eu pedi antes, explique com exatidão o resultado do código e o resultado desejado, coloque as duas situações e as explicações e publique a planilha ao invés das fotos.

Compartilhar este post


Link para o post
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisar ser um membro para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora





Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas publicações sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...

Aprenda_a_Ler_Resistores_e_Capacitores-capa-3d-newsletter.jpg

EBOOK GRÁTIS!

CLIQUE AQUI E BAIXE AGORA MESMO!