Ir ao conteúdo
  • Cadastre-se
Regras do Clube do Hardware

Excel Macro p/ verificar uma condição e executar algumas ações

ewpreis

Por ewpreis
em Microsoft Office e similares

 Compartilhar

Posts recomendados

ewpreis
 

ewpreis

Postado
Postado

Boa tarde senhores,

 

Estou quebrando a cabeça para montar uma macro mas não estou conseguindo montar sua lógica.

Preciso de uma macro onde ela irá olhar para primeira linha (A1) se for "XX XXXX" ela irá recortar "XX" e colar em D3, depois recortar "XXXX" e colar em E3.

Após fazer isso irá olhar para C3, se nesta célula tiver uma informação do tipo "XXXX XXXX" (Um nome) vai em A3 e nessa célula vai ter uma informação de data e hora. Quero recortar a hora "00:00" e colar em B3, na coluna A3 manter a data no formato "00/00/00".

E depois verificar se na linha abaixo tem um nome do tipo "XXXX XXXX", se tiver vai refazer o passo acima com as informações dessa linha. Se for falso irá excluir a primeira e segunda linha, movendo as linhas pra cima.

 

Desde já agradeço,

 

Abraço.

 

Link para o comentário
Compartilhar em outros sites
ewpreis
 

ewpreis

Postado
  • Autor
Postado
14 horas atrás, CasaDoHardware disse:

Monte um exemplo igual a sua planilha, os dados podem ser diferentes.

 

Mostre o resultado esperado 

 

E poste no forum.

 

Fica mais fácil conseguir ajuda.

 

Eu quero pegar esses dados:

img1.thumb.JPG.973cc7733f216f42f038e492bed8f472.JPG

 

E organizar desse jeito:

img2.JPG.64caab530b378712620824a1bc6e9974.JPG

 

As mudanças:

IMG3.thumb.JPG.968852573c98419afb957ac50f37e7bb.JPG

Link para o comentário
Compartilhar em outros sites
R0DR1G0_CWB
 

R0DR1G0_CWB

Postado
Postado

Bom dia...

 

@CasaDoHardware

16 horas atrás, CasaDoHardware disse:

Monte um exemplo igual a sua planilha, os dados podem ser diferentes.

Não se acostumou ainda com dúvidas sem exemplos? ^_^

 

@ewpreis

Imagens não ajuda muito, uma frase que já foi citado em outros post se aplica a essa situação.

"Você precisa ajudar a ser ajudado"

 

Poste uma amostra da sua planilha para que os apoiadores possam saber todos os cenários possíveis e incluir na lógica que deverá ser aplicada no VBA, monte com dados fictícios mesmo, pois 99% dos membros que apoiam na solução dos problemas não perdem tempo montando as planilhas do zero.

 

Link para o comentário
Compartilhar em outros sites
ewpreis
 

ewpreis

Postado
  • Autor
Postado
44 minutos atrás, R0DR1G0_CWB disse:

Bom dia...

 

@CasaDoHardware

Não se acostumou ainda com dúvidas sem exemplos? ^_^

 

@ewpreis

Imagens não ajuda muito, uma frase que já foi citado em outros post se aplica a essa situação.

"Você precisa ajudar a ser ajudado"

 

Poste uma amostra da sua planilha para que os apoiadores possam saber todos os cenários possíveis e incluir na lógica que deverá ser aplicada no VBA, monte com dados fictícios mesmo, pois 99% dos membros que apoiam na solução dos problemas não perdem tempo montando as planilhas do zero.

 

 

Pode deixar, segue anexado o modelo com os dados que quero organizar

 

modelo.xlsx

Link para o comentário
Compartilhar em outros sites
ewpreis
 

ewpreis

Postado
  • Autor
Postado

Consegui fazer o início da macro, mas da forma que fiz não analisa a informação da célula que quero editar e já joga o valor que está escrito na macro. Queria deixar mais automático para eu não ter que me preocupar com esses detalhes já que é uma rotina com muitas informações

  

Sub ORGANIZAR_DADOS()
'
' ORGANIZAR_DADOS Macro
' Organiza os dos
'
' Atalho do teclado: Ctrl+q
'
    ActiveSheet.Shapes.Range(Array("Picture 1")).Select
    Selection.Delete
    Rows("1:6").Select
    Range("F1").Activate
    Selection.Delete Shift:=xlUp
    Range("A1:F1").Select
    Columns("C:D").Insert
    Columns("B").Insert
    Range("A1:I1").Select
    ActiveCell.FormulaR1C1 = ""
    Range("D3").Select
    ActiveCell.FormulaR1C1 = "75"
    Range("E3").Select
    ActiveCell.FormulaR1C1 = "ART1"
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "7/1/2018"
    Range("B3").Select
    ActiveCell.FormulaR1C1 = "7:17"
    Range("A2").Select
    ActiveCell.FormulaR1C1 = ""
    Range("A1:I1").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.UnMerge
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Data de Registro"
    Range("A1:B1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "Data"
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "Hora"
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "Linha"
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "Máquina"
    Range("C1:C2").Select
    Range("C2").Activate
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("D1:D2").Select
    Range("D2").Activate
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("E1:E2").Select
    Range("E2").Activate
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("F1:F2").Select
    Range("F2").Activate
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("G1:G2").Select
    Range("G2").Activate
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("H1:H2").Select
    Range("H2").Activate
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("I1:I2").Select
    Range("I2").Activate
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("A1:I2").Select
    Range("I1").Activate
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("A6").Select
    ActiveCell.FormulaR1C1 = "7/1/2018"
    Range("B6").Select
    ActiveCell.FormulaR1C1 = "7:17"
    Range("A4:I4").Select
    ActiveCell.FormulaR1C1 = ""
    Range("D6").Select
    ActiveCell.FormulaR1C1 = "75"
    Range("E6").Select
    ActiveCell.FormulaR1C1 = "FP1"
    Range("A6:B6").Select
    Selection.Copy
    Range("A7:B13").Select
    ActiveSheet.Paste
    Range("D6:E6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("D7:E13").Select
    ActiveSheet.Paste
    Rows("4:5").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    ActiveWindow.SmallScroll Down:=3
    Range("A14").Select
    ActiveCell.FormulaR1C1 = "7/1/2018"
    Range("B14").Select
    ActiveCell.FormulaR1C1 = "7:17"
    Range("A12:I12").Select
    ActiveCell.FormulaR1C1 = ""
    Range("D14").Select
    ActiveCell.FormulaR1C1 = "75"
    Range("E14").Select
    ActiveCell.FormulaR1C1 = "FP1"
    Range("A14:B14").Select
    Selection.Copy
    Range("A15:B22").Select
    ActiveSheet.Paste
    Range("D14:E14").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("D15:E22").Select
    ActiveSheet.Paste
    Rows("12:13").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    ActiveWindow.SmallScroll Down:=3
    Range("A23").Select
    ActiveCell.FormulaR1C1 = "7/1/2018"
    Range("B23").Select
    ActiveCell.FormulaR1C1 = "7:17"
    Range("A21:I21").Select
    ActiveCell.FormulaR1C1 = ""
    Range("D23").Select
    ActiveCell.FormulaR1C1 = "75"
    Range("E23").Select
    ActiveCell.FormulaR1C1 = "FP2"
    Range("A23:B23").Select
    Selection.Copy
    Range("A24:B31").Select
    ActiveSheet.Paste
    Range("D23:E23").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("D24:E31").Select
    ActiveSheet.Paste
    Rows("21:22").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    ActiveWindow.SmallScroll Down:=3
    Range("A32").Select
    ActiveCell.FormulaR1C1 = "7/1/2018"
    Range("B32").Select
    ActiveCell.FormulaR1C1 = "7:17"
    Range("A30:I30").Select
    ActiveCell.FormulaR1C1 = ""
    Range("D32").Select
    ActiveCell.FormulaR1C1 = "75"
    Range("E32").Select
    ActiveCell.FormulaR1C1 = "FP3"
    Range("A32:B32").Select
    Selection.Copy
    Range("A33:B40").Select
    ActiveSheet.Paste
    Range("D32:E32").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("D33:E40").Select
    ActiveSheet.Paste
    Rows("30:31").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    ActiveWindow.SmallScroll Down:=3
End Sub

 

Link para o comentário
Compartilhar em outros sites
CasaDoHardware
 

CasaDoHardware

Postado
Postado
9 horas atrás, R0DR1G0_CWB disse:

Não se acostumou ainda com dúvidas sem exemplos? ^_^

Não tenho bola de cristal e sem saber como é a planilha na maioria dos casos eu nao consigo ajudar.

 

Se você tem esta capacidade de ajudar todos sem ver a planilha de quem pede ajuda parabens pra você.

 

E como eu costumo realmente dizer e você repetiu.

 

Quem quer ajuda precisa ajudar a obter ajuda.

 

  • Amei 1
Link para o comentário
Compartilhar em outros sites
ewpreis
 

ewpreis

Postado
  • Autor
Postado

@@R0DR1G0_CWB @Márcio Rodrigues Teria como anexar sem ser compactado pelo winrar. Aqui no PC do trabalho não tenho instalado e não consigo instalar, ia ver quando cheguei em casa mas já cheguei pegando o carro e indo levar minha irmã no médico. Quando voltei, só tomei um banho e dormi, acabei não conseguindo ver isso em casa ontem

 

Ah, muito obrigado pela ajuda.

Link para o comentário
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisa ser um usuário 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
 Compartilhar
Ir à lista de tópicos

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades 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

Mais

×
×
  • Criar novo...

 

GRÁTIS: ebook Redes Wi-Fi – 2ª Edição

EBOOK GRÁTIS!

CLIQUE AQUI E BAIXE AGORA MESMO!