Tópicos relacionados a códigos VBA, gravação de macros, etc.
Por GENECI 13 Jul 2019 às 18:20
Membro 2 Estrelas
Mensagens: 194
Reputação: 1
#45548
Boa tarde.

Solicito a sua ajuda de acordo com a arquivo anexo.

Grato,

Geneci.
Apenas usuários registrados podem ver ou baixar anexos.
Por babdallas 13 Jul 2019 às 20:41
Membro 5 Estrelas
Mensagens: 1749
Reputação: 778
#45550
Fiz com fórmula. Veja se é o que deseja.
Apenas usuários registrados podem ver ou baixar anexos.
Por GENECI 14 Jul 2019 às 16:15
Membro 2 Estrelas
Mensagens: 194
Reputação: 1
#45562
Boa tarde, babdallas.

Muito obrigado por atender a minha solicitação.

A fórmula que você elaborou atende sim a minha necessidade.

Quero aprofundar o conhecimento em VBA, vou aguardar uma outra resposta através do VBA.

Muito obrigado.

Geneci.
Por osvaldomp 14 Jul 2019 às 18:39
Membro 5 Estrelas
Mensagens: 1252
Reputação: 613
#45565
Olá, Geneci.

Veja se atende.
Cole uma cópia dos três códigos abaixo no módulo da Plan1 e em qualquer célula vazia coloque =A1.
funcionamento - os valores em D1:F1 serão atualizados pelos códigos após a alteração manual do nome em C1 ou após a mudança da hora em A1, manualmente ou via código MeuRelogio já existente no Módulo1.

Código: Selecionar todosPrivate Sub Worksheet_Calculate()
 LocalizaPessoa
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Address = "$C$1" Then LocalizaPessoa
End Sub

Sub LocalizaPessoa()
 Dim n As Long, k As Long, c As Long
  n = Range("B2:B" & Cells(Rows.Count, 2).End(3).Row).Find([C1]).Row
  For k = 3 To 15 Step 4
   If Cells(n, k) <= [A1] And Cells(n, k + 1) >= [A1] Then
    [D1] = Cells(n, k): [E1] = Cells(n, k + 2): [F1] = Cells(n, k + 1): Exit Sub
   End If
  Next k
  [D1:F1] = "": [D1] = "ausente"
End Sub


sugestão - verifique a conveniência de alterar o tempo de disparo do código MeuRelogio de 1 seg para 10 ou para 30 min