Excel contador automático conforme o mês ano e célula.

[GENECIOFICIAL]

Boa tarde! Feliz ano novo.

 

Dúvida posta em outra fórum.

 

Conforme o anexo, solicito a sua ajuda.

 

Grato.

contador anual.xlsx

[Scofieldgyn]

@GENECIOFICIAL

Não entendi muito bem sua solitação, aparentemente parece bem simples o que deseja, mas quase certeza que você vai dizer que não é o que espera.

 

se puder explicar melhor, talvez seja só eu que não entendi mesmo.

 

[GENECIOFICIAL]

Bom dia!

 

Muito obrigado pela fórmula.

 

A célula H10, foi preenchida com o texto blablabla, a contador da célula D4, deve iniciar com 01/jan/2023, se alterar o texto da célula H10, o contador deve mudar para 02/jan?2023.

 

E assim segue a contagem, conforme a explicação anterior. 

 

Grato.

[Scofieldgyn]

@GENECIOFICIAL

 

Nesse caso a solução é fazer um loop, vou pasar a vez para os colegas resolverem.

[GENECIOFICIAL]

Muito obrigado pela iniciativa.

[GENECIOFICIAL]

Em 04/01/2023 às 14:43, GENECIOFICIAL disse:

Muito obrigado pela iniciativa.

Boa tarde!

 

Alguém pode sanar o minha dúvida?

 

Grato.

[Midori]

Veja se assim resolve,

 

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$H$10" Then
        [D4].Value = Sequencia([D4])
    End If
End Sub

Function Sequencia(Celula As Range) As String
    Dim Contador    As Long
    Dim Ano         As Integer
    Dim Valor       As Variant
    Dim Mes         As String
    Dim MesAtual    As String
    
    MesAtual = MonthName(Month(Date), True)
    Valor = Split(Celula.Value, "/")
    Contador = Valor(0)
    Ano = Valor(2)
    Mes = MonthName(Month( _
        DateSerial(Ano, Int(Valor(1)), 1)), True)
    
    If Year(Date) <> Ano Then
        Contador = 1
        Mes = MesAtual
        Ano = Year(Date)
    Else
        If Mes <> MesAtual Then
            Mes = MesAtual
        End If
        Contador = Contador + 1
    End If
    
    Sequencia = Format(Contador, "00") & "/" & Mes & "/" & Ano
End Function

 

[GENECIOFICIAL]

Boa tarde!

Gratidão pelo tempo atribuído ao problema.

 

Para o Ofiice 2016, apresentou o seguinte erro.

 

Quando possível pode verificar.

 

Muito obrigado.

[Midori]

@GENECIOFICIAL Em qual linha acontece o erro? A célula D4 está no formato de data ou texto?

[GENECIOFICIAL]

A célula D4 com os formatos: texto, data, número e personalizado ao preencher a célula H10, apresenta a mensagem.

 

Grato.

[Midori]

@GENECIOFICIAL Para acontecer esse erro a célula deve estar em branco ou com um valor sem barras. Coloque um valor válido antes de testar.

 

Outra coisa que eu devia ter perguntado antes, esse contador pode deixar a célula D4 com um formato de data inválido? Tipo 32/Jan/2023?

[GENECIOFICIAL]

Resposta: Sim

O contador para o mês de janeiro pode ultrapassar o número 31, como também não atingir o número 31, por exemplo chegar apenas ao número 17 por exemplo, o número é sequencial o que muda é o mês e o ano.

 

Não há relação alguma, com a quantidade de dias de cada mês.

 

Anexo outro arquivo, explicando com outras palavras.

 

Grato.

CONTADOR CONDICIONAL DIA MES ANO.xlsx

[Midori]

@GENECIOFICIAL A célula D4 deve ficar no formato texto. E na primeira execução caso a célula já tenha uma data em outro formato que não seja texto, converta ou formate para texto antes.

 

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$H$10" Then
        If TypeName([D4].Value) = "String" Or [D4].Value = "" Then
            [D4].Value = Sequencia([D4])
        End If
    End If
End Sub

Function Sequencia(Celula As Range) As String
    Dim Contador    As Long
    Dim Ano         As Integer
    Dim Valor       As Variant
    Dim Mes         As String
    Dim MesAtual    As String
    
    MesAtual = MonthName(Month(Date), True)
    
    If Celula.Value = "" Then
        Sequencia = "01/" & MesAtual & "/" & Year(Date)
    Else
        Valor = Split(Celula.Value, "/")
        Contador = Valor(0)
        Mes = Valor(1)
        Ano = Valor(2)
        
        If Year(Date) <> Ano Then
            Contador = 1
            Mes = MesAtual
            Ano = Year(Date)
        Else
            If Mes <> MesAtual Then
                Mes = MesAtual
            End If
            Contador = Contador + 1
        End If
        Sequencia = Format(Contador, "00") & "/" & Mes & "/" & Ano
    End If
End Function

 

[GENECIOFICIAL]

17 horas atrás, Midori disse:

@GENECIOFICIAL A célula D4 deve ficar no formato texto. E na primeira execução caso a célula já tenha uma data em outro formato que não seja texto, converta ou formate para texto antes.

 

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$H$10" Then
        If TypeName([D4].Value) = "String" Or [D4].Value = "" Then
            [D4].Value = Sequencia([D4])
        End If
    End If
End Sub

Function Sequencia(Celula As Range) As String
    Dim Contador    As Long
    Dim Ano         As Integer
    Dim Valor       As Variant
    Dim Mes         As String
    Dim MesAtual    As String
    
    MesAtual = MonthName(Month(Date), True)
    
    If Celula.Value = "" Then
        Sequencia = "01/" & MesAtual & "/" & Year(Date)
    Else
        Valor = Split(Celula.Value, "/")
        Contador = Valor(0)
        Mes = Valor(1)
        Ano = Valor(2)
        
        If Year(Date) <> Ano Then
            Contador = 1
            Mes = MesAtual
            Ano = Year(Date)
        Else
            If Mes <> MesAtual Then
                Mes = MesAtual
            End If
            Contador = Contador + 1
        End If
        Sequencia = Format(Contador, "00") & "/" & Mes & "/" & Ano
    End If
End Function

 

Bom dia! O código funcionou conforme a solicitação.

 

Muito obrigado.

 

Grato.