Este fórum está sendo desativado

[SandroLima]

Boa tarde, pessoal

Preciso de ajuda para completar o código na linha:

Código: Selecionar todos

.Range("Consulta_Data").Value2 = ???????????????

Preciso que retorne a Data no formato numérico xx/xx/xxxx, sendo que o Mês e Ano correspondem aos intervalos nomeados na planilha "MesReferencia_AD" e "AnoReferencia_AD". O dia é dado pelo código ao abrir a planilha.
Portanto preciso que o dia permaneça inalterado mudando apenas o Mês e o Ano conforme alteração nos campos Mês e Ano.

Segue o código e planilha anexa:

Código: Selecionar todos

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim TabelaConsulta As ListObject, TabelaConsulta2 As ListObject
        
    Set TabelaConsulta = wshAtivDiarias.ListObjects("TB_ConsultaAtivCadastrada")
    Set TabelaConsulta2 = wshPlanAuxiliar.ListObjects("TB_ConsultaAtivCadastrada2")
    
    Application.ScreenUpdating = False
    
    On Error Resume Next
    
    If Not Application.Intersect(Target, wshAtivDiarias.Range("MesReferencia_AD")) Is Nothing Then
        With wshPlanAuxiliar
            .Range("MesReferencia_AUX").Value2 = wshAtivDiarias.Range("MesReferencia_AD").Value2
        End With
    End If
    
    If Not Application.Intersect(Target, wshAtivDiarias.Range("AnoReferencia_AD")) Is Nothing Then
        With wshPlanAuxiliar
            .Range("AnoReferencia_AUX").Value2 = wshAtivDiarias.Range("AnoReferencia_AD").Value2
        End With
    End If
    
    'If Not Application.Intersect(Target, wshAtivDiarias.Range("MesReferencia_AD")) _
        'Or Application.Intersect(Target, wshAtivDiarias.Range("AnoReferencia_AD")) Is Nothing _
            'And VBA.IsDate(Target.Value) Then
                'With wshAtivDiarias
                    '.Range("Consulta_Data").Value2 = ???????????????
                                                    
                                                    '(preciso que altere a data retornando com o Mês do Range MesReferencia_AD
                                                    
                                                    ' e o ano do Range AnoReferencia_AD no formato xx/xx/xxxx (numérico)... o dia permanece o mesmo e será dado pelo código que inicia a planilha.
                'End With
    'End If
    
    If Not Application.Intersect(Target, TabelaConsulta.ListColumns("Data").DataBodyRange) Is Nothing And VBA.IsDate(Target.Value) Then
        With wshPlanAuxiliar
            .Range("Consulta_Data2").Value = wshAtivDiarias.Range("Consulta_Data").Value
        End With
    End If
    
    If Not Application.Intersect(Target, TabelaConsulta.ListColumns("Fluxo").DataBodyRange) Is Nothing Then
        With wshPlanAuxiliar
            .Range("Consulta_Fluxo2").Value = wshAtivDiarias.Range("Consulta_Fluxo").Value
        End With
    End If
    
    If Not Application.Intersect(Target, TabelaConsulta.ListColumns("Periodicidade").DataBodyRange) Is Nothing Then
        With wshPlanAuxiliar
            .Range("Consulta_Periodicidade2").Value = wshAtivDiarias.Range("Consulta_Periodicidade").Value
        End With
    End If
    Application.ScreenUpdating = True
    
End Sub

Se houver erros no código ou for possível resumi-lo aceito sugestões.

Obrigado a quem puder colaborar.

[AugustoFranciosi]

Olá amigo!

Tentei montar uma solução sem macro, espero que não se importe.

Se não for isso que você queria, peço desculpas!

[SandroLima]

Opa, amigo.

Agradeço pela iniciativa... mas preciso da solução em VBA mesmo.

O campo data pode ser alterado manualmente também se o usuário desejar. E a rotina retorna o campo para o dia atual após executada a macro.

De qualquer forma obrigado.

[SandroLima]

Boa noite.

Alguém sabe como finalizar a linha mencionada do código?

[JCabral]

Experimente

Código: Selecionar todos

.Range("Consulta_Data").Value2 = DateSerial(AnoReferencia_AD, MesReferencia_AD, Day(Now))

[SandroLima]

Bom dia, pessoal do fórum.

Primeiro mil perdões... havia anexado a planilha errada.

Obrigado, JCabral... pela disposição em colaborar. Infelizmente não funcionou.

Segue o código com a implementação da linha sugerida:

Código: Selecionar todos

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim TabelaConsulta As ListObject, TabelaConsulta2 As ListObject
        
    Set TabelaConsulta = wshAtivDiarias.ListObjects("TB_ConsultaAtivCadastrada")
    Set TabelaConsulta2 = wshPlanAuxiliar.ListObjects("TB_ConsultaAtivCadastrada2")
    
    Application.ScreenUpdating = False
    
    On Error Resume Next
    
    If Not Application.Intersect(Target, wshAtivDiarias.Range("MesReferencia_AD")) Is Nothing Then
        With wshPlanAuxiliar
            .Range("MesReferencia_AUX").Value2 = wshAtivDiarias.Range("MesReferencia_AD").Value2
        End With
    End If
    
    If Not Application.Intersect(Target, wshAtivDiarias.Range("AnoReferencia_AD")) Is Nothing Then
        With wshPlanAuxiliar
            .Range("AnoReferencia_AUX").Value2 = wshAtivDiarias.Range("AnoReferencia_AD").Value2
        End With
    End If
    
    If Not Application.Intersect(Target, wshAtivDiarias.Range("MesReferencia_AD")) _
        Or Application.Intersect(Target, wshAtivDiarias.Range("AnoReferencia_AD")) Is Nothing _
            And VBA.IsDate(Target.Value) Then
                With wshAtivDiarias
                    '.Range("Consulta_Data").Value2 = ?????????
                                                    
                                                    '(preciso que altere a data retornando com o Mês do Range MesReferencia_AD
                                                    
                                                    ' e o ano do Range AnoReferencia_AD no formato xx/xx/xxxx (numérico)
                                                    
                                                    'o dia permanece o mesmo e será dado pelo código que inicia a planilha.
                    .Range("Consulta_Data").Value2 = DateSerial(AnoReferencia_AD, MesReferencia_AD, Day(Now))
                End With
    End If
    
    If Not Application.Intersect(Target, TabelaConsulta.ListColumns("Data").DataBodyRange) Is Nothing And VBA.IsDate(Target.Value) Then
        With wshPlanAuxiliar
            .Range("Consulta_Data2").Value = wshAtivDiarias.Range("Consulta_Data").Value
        End With
    End If
    
    If Not Application.Intersect(Target, TabelaConsulta.ListColumns("Fluxo").DataBodyRange) Is Nothing Then
        With wshPlanAuxiliar
            .Range("Consulta_Fluxo2").Value = wshAtivDiarias.Range("Consulta_Fluxo").Value
        End With
    End If
    
    If Not Application.Intersect(Target, TabelaConsulta.ListColumns("Periodicidade").DataBodyRange) Is Nothing Then
        With wshPlanAuxiliar
            .Range("Consulta_Periodicidade2").Value = wshAtivDiarias.Range("Consulta_Periodicidade").Value
        End With
    End If
    
    Application.ScreenUpdating = True
    
End Sub

Envio a planilha anexa.

Obrigado a todos que puderem colaborar.

[JCabral]

Veja se ajuda

[SandroLima]

Bom dia, JCabral. Obrigado de novo pela ajuda.

Aqui no seu anexo funcionou certinho. No meu está informando que a variável "mes" não foi declarada.

Onde vc declarou a variável? Não encontrei.

Tentei resolver assim:

Código: Selecionar todos

If DateSerial(Year(Data_Consulta_Data), Month(Data_Consulta_Data), Day(Data_Consulta_Data)) = DateSerial(CInt([AnoReferencia_AD]), CInt([MesReferencia_AD]), Day(Now)) Then Exit Sub
                    .Range("Consulta_Data").Value2 = DateSerial(CInt([AnoReferencia_AD]), CInt([MesReferencia_AD]), Day(Now))

Mas não deu certo.

[JCabral]

SandroLima

Atenção que "mês" não é uma variável é uma função, que está no anexo que eu te enviei.
Ter tb em atenção o resto do código que alterei para que não surja um problema de recursividade.

[SandroLima]

Ok... Obrigado.