Excel Exibir o conteúdo das células durante 15 segundos.

[GENECIOFICIAL]

Bom dia!

 

Conforme o anexo, solicito a sua ajuda.

 

Grato.

apresentação.xlsx

[AfonsoMira]

Boas @GENECIOFICIAL ,
Veja se é isto que pretende:
 

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = "$A$1" Then
    
    'Coloca Valor
    ActiveSheet.Range("B1").Formula2R1C1 = "=IFERROR(INDEX(INDIRECT(""$B$""&ROW(XLOOKUP(RC[-1],R2C1:R151C1,R2C2:R151C2))):R[150]C, MATCH(FALSE,INDIRECT(""$B$""&ROW(XLOOKUP(RC[-1],R2C1:R151C1,R2C2:R151C2))):R[150]C="""",0)),""Não existe valor"")"
    
    'Tempo de Pausa
    Application.Wait (Now + TimeValue("0:00:15"))
    
    'Retira Valor
    ActiveSheet.Range("B1").Value2 = ""
End If

End Sub

 

[GENECIOFICIAL]

@AfonsoMira Bom dia!

Muito obrigado por atender a minha solicitação.

Apresentou a seguinte mensagem de erro.

Pode verificar a ocorrência.

Grato.

29 minutos atrás, AfonsoMira disse:

Boas @GENECIOFICIAL ,
Veja se é isto que pretende:
 

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = "$A$1" Then
    
    'Coloca Valor
    ActiveSheet.Range("B1").Formula2R1C1 = "=IFERROR(INDEX(INDIRECT(""$B$""&ROW(XLOOKUP(RC[-1],R2C1:R151C1,R2C2:R151C2))):R[150]C, MATCH(FALSE,INDIRECT(""$B$""&ROW(XLOOKUP(RC[-1],R2C1:R151C1,R2C2:R151C2))):R[150]C="""",0)),""Não existe valor"")"
    
    'Tempo de Pausa
    Application.Wait (Now + TimeValue("0:00:15"))
    
    'Retira Valor
    ActiveSheet.Range("B1").Value2 = ""
End If

End Sub

 

 

[Midori]

@GENECIOFICIAL O que deve ser mostrado é a partir do valor de A1 até o último do intervalo B2:B151? Pegando o seu exemplo do número 10 teria que mostrar 8 valores, é isso?

[GENECIOFICIAL]

2 minutos atrás, Midori disse:

@GENECIOFICIAL O que deve ser mostrado é a partir do valor de A1 até o último do intervalo B2:B151? Pegando o seu exemplo do número 10 teria que mostrar 8 valores, é isso?

Bom dia! Midori

 

O valor que eu digitar na célula A1,

o VBA deverá fazer a sequência até a última célula da coluna B, com  conteúdo.

Explicando com outras palavras, quero uma apresentação parcial ou total das mensagens.

 

Grato.

[Midori]

@GENECIOFICIAL Veja se é isto,

 

Cole no módulo da planilha,

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$A$1" And IsNumeric(Target.Value) Then
        Call IniciaConteudo(Target, [A2:A151])
    End If
End Sub

 

E este em um módulo de Inserir > Modulo,

Private Fim         As Long
Private Indice      As Long
Private Celula      As Range
Private Conta       As Long

Sub IniciaConteudo(rIni As Range, Area As Range)
    Fim = Area(Area.Rows.Count).Row
    Indice = 0
    Conta = 0
    Set Celula = Area.Find(What:=rIni.Value, LookIn:=xlValues, LookAt:=xlWhole)
    
    If Not Celula Is Nothing And Fim > rIni.Value Then
        Call MostraConteudo
    End If
End Sub

Sub MostraConteudo()
    Conta = Conta + 1
    If Conta < Fim Then
        Indice = Indice + 1
        If Celula(Indice, 2).Value <> "" Then
            [B1].Value = Celula(Indice, 1).Value & " de " & Fim & " " & Celula(Indice, 2).Value
            Call Application.OnTime(Now + TimeValue("00:00:15"), "MostraConteudo")
        Else
            Call Application.OnTime(Now, "MostraConteudo")
        End If
    End If
End Sub