Felipe2791

Os dados que ficam no quadro de resumo só devem aparecer o que foi imputado no quadro de cima.Isso que disse é um espelho, realmente eu preciso de um espelhamento, mas só do que for inputado, a parte em branco não vem.

Bom dia pessoal,

Estou com um problema em uma planilha de uso diário, e para agilizar o funcionamento preciso disso:

No primeiro quadro eu faço um tipo de programação mensal, no quadrado de baixo é um resumo dessa programão. Preciso basicamente que quando o quadro de cima seja dado input manual (linhas 4,6 e 8) eles sejam importados automaticamente para o campo de baixo RESUMO, junto com a data (dados fixos).

Eu consegui a formula abaixo, ela faz esse processo nos dados inputados, mas só funciona com uma linha, pois quando tem inputs em datas diferentes a formula não faz os dados "passarem".

SEERRO(ÍNDICE($A$2:$AG$2;1;1/(1/AGREGAR(15;7;1/(1/(($F$4:$AG$4>0)*COL($F$4:$AG$4)));COL(A1))));"0")

Teste.zip

Resolvido.

Obrigado amigo!

Colocarei na linha de cima em amarelo os dados sem sequencia, algumas células em branco e outras com números.

Preciso que na linha amarela de baixo (ou a de cor equivalente para representação) mostre os dados que estão na linha de cima, mas em sequencia.

Do mesmo jeito que você fez acima. Fiz um modelo preenchido no anexo.

Nova Pasta Compactada.zip

Caro DJunqueira, funcionou, na verdade eu usava algo parecido para PROCH no mesmo estilo, mas assim como a formula que eu usava não consegui adaptar em minha planilha.

Veja abaixo minha planilha em construção, pode me ajudar na adaptação?

Nova Pasta Compactada.zip

Bom dia,

Tenho uma planilha onde tem os 30 dias do mês em linha, na linha de baixo é preenchido valores em cada dia, mas tem alguns que ficam sem preencher.

Preciso de uma formula que colete esses dados para outras células eliminando os espaços sem entrada e em sequencia.

Segue modelo em anexo para melhor entendimento.

Teste.xlsx

8 minutos atrás, Basole disse:

Com eu disse anteriormente, não testei o codigo pois nao tenho o outlook habilitado. 

Segeu abaixo c/ as correçoes, substitua no modulo1 da sua planilha:

 

Option Explicit

Sub Enviar_Email()
    '  *****   Envia e-mail pelo Outlook
    Dim OutApp As Object
    Dim OutMail As Object
    Dim texto As String
    Dim uL As Long
    Dim rng As Range, c As Range
    
  uL = Sheets("Plan1").Cells(Rows.Count, 1).End(xlUp).Row
  
  Set rng = Sheets("Plan1").Range("A7:A" & uL)
     
 
    For Each c In rng
    If c.Value = "X" Then   ' (X maiusculo)
 
 
   Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
        
        With OutMail
            .To = Plan1.Cells(c.Row, 4)
            .CC = ""
            .BCC = ""
            .Subject = "Nível"
            .body = "Prezado(a) " & Plan1.Cells(c.Row, 3) & "," & vbCrLf & vbCrLf & _
                    "Segue acompanhamento do mês de Julho."
                    
             .Display    'Send para enviar o email sem abrir o Outlook
             .send
       End With
           On Error GoTo 0
       
        Set OutMail = Nothing
        Set OutApp = Nothing
      
        End If

   Next
    End Sub
 

 

@Basole Perfeito, testei em todos os cenários, inclusive enviando emails do relatório.

Agora é só o corpo de email e pronto.

Ótima ferramenta, obrigado a todos;

8 minutos atrás, Basole disse:

Bom dia,

Felipe segue em anexo com as correções: 

teste-Basole-v2.xlsm

@BasoleApareceu depuração na linha que indica o endereço de email:

.To = Plan1.Cells(linha, 4)

Acho que Planilha Dinâmica seria ideal, e poderia fazer em pastas de trabalho diferentes tambem.

Bom dia,

Selecione a coluna, vá em Formatação Condicional>Nova Regra>Formatar apenas celulas que contenham>Deixe a primeira variável em Valor da célula e a segunda voce escolhe o que quer, no caso "é igual a">na terceira váriavel escreva o texto que quer e em Formatar coloque a cor, estilo da célula e fonte que deseja quando a palavra for escrita.

Em 21/03/2016 às 17:14, Basole disse:

O error aparece por causa do Target

Tente declarar o objeto desta forma:

Dim Target as range

 

@Basole Mesma coisa, Quando coloco o X apenas na segunda ele trava o Excel, se coloco nas 3 primeiras e pulo pra quinta, ele para de enviar na terceira.

Já tentei mas não consegui. 

Citação

Postado ontem às 17:32 · Denunciar post

Na verdade tem que apagar essa variavel

 

Apague essa linha tb

@CasaDoHardware O seu codigo não consegui colocar para funcionar de forma alguma, a parte dos rastreio da condição está perfeita, mas os emails não disparam, já eliminei tudo que pediu.

Não acha melhor deixar só o texto na C1 e o valor na D1, fazer sua formatação condicional como quiser (e até pode fazer com que pareça que seja apenas uma celula, tirando linhas e diminuindo elas). Se precisar dos valores juntos para alguma função na planilha voce junta elas na E1 e oculta, usando somente para a função desejada.

8 minutos atrás, CasaDoHardware disse:

 

 

Tente apagar essa linha do erro e o ultimo end if que esta acima  do end sub

ela fica carregando (mesmo com 3 linhas ativas e 1 x) quando aperto ESC ele pede para depurar a linha seguinte.

16 minutos atrás, CasaDoHardware disse:

Digite x na celula A7 e faça o seguinte:

 

Abra o Editor VBA 

 

No codigo enviomassa depure o codigo e siga passo a passo ate a finalizar e diga se apresenta algum erro

 

Eu nao tenho como testar mas se seu codigo funciona tem que funcionar dessa forma porque quando você coloca x em A7 (serve qualquer celula da coluna A), ele aceita o if que criei como verdadeiro e executa a macro enviar que alterei o nome da sua para enviar.

 

você fez essa alteração na Planilha original trocou o nome da sua macro para enviar e colou ela em um modulo?

 

Veja que essa codigo faz somente isso 

 

Ele seleciona a coluna D e enquanto a coluna D nao estiver Vazia ele vai rodar 

O teste if verifica se a celula da coluna A tem um x se tiver executa a macro Enviar (sua macro com novo nome que deve se copiada e colada em um modulo), se nao existir um x na linha da coluna A ele simplesmente pula para a proxima, ate encontrar uma linha vazia na coluna D.

 

 

 

 

Sub EnvioMassa()
 

'Seleciona a primeira celula com email da coluna D 
Range("D7").Select
 

'Enquanto a nao encontrar uma celula Vazia na coluna D executa o que vem a seguir
Do While ActiveCell <> ""
 

Se a celula da linha ativa na coluna A existir um x
If ActiveCell.Offset(0, -3).Value = "x" Then
 

'Executa a macro Enviar (sua macro acima com o nome Private Sub Enviar () que esta no modulo com o arquivo que enviei)
Enviar
 Se nao
Else
 Pula uma linha
ActiveCell.Offset(1, 0).Select
 
 
End If
 
 Reinicia o codigo 
Loop
 
End Sub

 

então se você fez isso tudo conforme esta acima tem que funcionar.

Eu tenteide tudo botar para funcionar, mas ele retornar a depuração no meu VBA, na linha: If Target.Address = "$A$" & linha Then

Private Sub Enviar()

'Envia e-mail pelo Outlook

    Dim OutApp As Object
    Dim OutMail As Object
    Dim texto As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    linha = ActiveCell.Row - 1
    If Target.Address = "$A$" & linha Then
    If Plan1.Cells(linha, 1) = "x" Then

        With OutMail
            .To = Plan1.Cells(linha, 4)
            .CC = ""
            .BCC = ""
            .Subject = "Nível"
            .Body = "Prezado(a) " & Plan1.Cells(linha, 3) & "," & vbCrLf & vbCrLf & _
                    "Segue acompanhamento do mês de Julho."
                    
                    
            .Display    'Send para enviar o email sem abrir o Outlook
        End With
        On Error GoTo 0
        End If

        Set OutMail = Nothing
        Set OutApp = Nothing
        
    End If
    End Sub

14 minutos atrás, CasaDoHardware disse:

você testou a alteração que postei????

Nesta Linha

 

if activecell.offset(0,1).value = "X" then

 

troque o X Maiusculo por x minusculo que vai funcionar

 

Testei sim, não pasou, ele faz a varredura mas não dispara email

39 minutos atrás, Basole disse:

Desculpe, acho que me equivoquei na orientacao acima.

 

Segue em anexo c/ as alteraçoes

 

teste-Basole-v1.xlsm

@Basole Para minha necessidade vai funcionar muito, mas tem um detalhe, quando ele encontra um problema (linha sem X) ele para e não "pula" para a proxima com X.

Eu vou usar a lista toda sempre, então tá tranquilo.

EDIT: Pensando bem, se tivesse como resolver esse problema eu agradeceria, pode ser que eu use.

7 minutos atrás, Basole disse:

Desculpe acrescente esta linha agentes da linha loop

Linha = linha + 1

@Basole Adicionei, ele envia 2 em sequencia e para.

8 minutos atrás, Basole disse:

@Felipe2791Segue em anexo com as adaptaçoes para voce testaar. 

Não testei pois nao tenho o outlook habilitado. 

 

* Só um detalhe dependendo do servidor de email (por exemplo o Gmail), nao vai 'deixar' voce enviar emails em massa. 

Pelo menos para mim aconteceu. Tenten a algum tempo atras, enviar emails 'por atacado' e o Gmail me bloqueou alegando spam. 

 

 

 

 

teste-Basole.xlsm

@Basole Não vou ter esse problema, o servidor é particular.

Um detalhe, o codigo está repetindo somente o primeiro email, não percorre a planilha. voce pode comprovar o problema porque o texto "nome 1..." aparece em todos emails aberto.

19 minutos atrás, CasaDoHardware disse:

Cometi um pequeno erro

 

Deveria ser assim

 

Range("A2").select 

 

Mas ja ajustei a macro a sua planilha é so copiar os codigos do modulo 1 e colar em um modulo de sua planilha original.

teste.xlsm

@CasaDoHardware

Eu fiz isso da outraz vez tambem, dessa maneira a varredura funciona.

Mas o email não é gerado no Display.

9 minutos atrás, CasaDoHardware disse:

Cometi um pequeno erro

 

Deveria ser assim

 

Range("A2").select 

 

Mas ja ajustei a macro a sua planilha é so copiar os codigos do modulo 1 e colar em um modulo de sua planilha original.

teste.xlsm

@CasaDoHardware

Esta retornando um erro no If Target.Address = "$A$" & linha Then do primeiro Script.

Tentei trocar algumas coisas, mas se colocarmos o X maiusculo o erro retorna, se coloco o minusculo faz a varredura mas não gera o email.

Bom dia,

Obrigado aos 2 que responderam.  @CasaDoHardware - @darkstrikerd

Tentei das dua manieiras e sem sucesso, acho que estou errando em algum detalhe, tenho algumas planilhas com alguns VBAs, mas o maximo que faço é modifica-los em detalhes da maneira que preciso.

Podem clarear ainda mais para mim?

EDIT: no caso da segunda resposta o Range ("A2).select não funciona no código.

Bom dia,

Tenho o código VBA abaixo, uso ele a um tempo. 

Como podem ver ele envia uma mensagem com conteudo de uma respectiva linha no Excel, a ativação é marcando um "x".

Estou tentando mudar a ativação do codigo, preciso que o email seja enviado com um botão, para que fiquei em massa.

Ou seja, tenho 100 linhas, se as 100 estiverem marcada com o "x" ao ativar o botão os emails sejam disparados juntos. Não precisa ser exatamene com x marcado, pode ser outro mecanismo, com tanto que a ação seja 1 só para todas as linhas.

Desde já obrigado!

EDIT: ADICIONEI A PLANILHA TESTE

Citação

Sub Worksheet_Change(ByVal Target As Range)

'Envia e-mail pelo Outlook

    Dim OutApp As Object
    Dim OutMail As Object
    Dim texto As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    linha = ActiveCell.Row - 1
    If Target.Address = "$A$" & linha Then
    If Plan1.Cells(linha, 1) = "x" Then

        With OutMail
            .To = Plan1.Cells(linha, 4)
            .CC = ""
            .BCC = ""
            .Subject = "Nível"
            .Body = "Prezado(a) " & Plan1.Cells(linha, 3) & "," & vbCrLf & vbCrLf & _
                    "Segue acompanhamento do mês de Julho."
                    
                    
            .Display    'Send para enviar o email sem abrir o Outlook
        End With
        On Error GoTo 0
        End If

        Set OutMail = Nothing
        Set OutApp = Nothing
        
    End If
    End Sub
 

teste.rar