Excel VBA - Trazer Resultados em "BA" "BD" "BF" "BJ"

[jcgmcs]

Peço ajuda para Trazer por VBA Resultados em "BA" "BD" "BF" "BJ"
Em "N" e "R" se eu alterar pra qualquer outro Status ou excluír,
as respectivas colunas adiante tbém se devem alterar.
A inserção de dados em "N" e "R" a partir da linha 5 é manual.

OBs: Em "BA" gostaria de tirar o espaço e incluír "/" entre Status e Ano.
obrigado!

Excel VBA - Trazer Resultados em BA_BD_BF_BJ.xls

[Midori]

O código para o módulo da planilha. A atualização será na edição das colunas,

 

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count = 1 And Target.Row >= 5 Then
        Dim Status  As Variant
        Dim Tipo    As String
        
        Status = Trim(Target.Value)
        
        If Target.Column = [N:N].Column Then
            Tipo = Right(Status, 2)
            If Tipo <> "ON" Then
                Tipo = Right(Status, 3)
            End If
            Cells(Target.Row, [BF:BF].Column).Value = Tipo
            
        ElseIf Target.Column = [R:R].Column Then
            Dim Ano     As String
            Dim MesAno  As String
            
            Tipo = Trim(Left(Status, InStr(Status, " ")))
            If Tipo <> "ATIVO" And Tipo <> "INATIVO" Then
                Tipo = ""
            Else
                Ano = "/" & Split(Status, "/")(2)
                MesAno = " " & Split(Status, "/")(1) & Ano
            End If
            
            Cells(Target.Row, [BA:BA].Column).Value = Tipo & Ano
            Cells(Target.Row, [BD:BD].Column).Value = Tipo & MesAno
            Cells(Target.Row, [BJ:BJ].Column).Value = Tipo
        End If
    End If
End Sub

 

[jcgmcs]

Bom dia!

Midori tá ficando show""

Achei q iria ser fácil adicionar uma nova coluna mas não tá dando certo...

Preciso adicionar a "BH" q trás o resultado de "BF" mas tbém com Mês e Ano de "R"

Como fazer isso...?

[jcgmcs]

Midori uma outra coisa...

Desculpe complicar um pouco ae mas éq não tá ocorrendo o que Achei q fosse ocorrer...
Preciso que sempre ao alterar as Colunas "J, L, M, N, Q ou R" 
que se faça tbém um tipo de Refresh nas
colunas: "AM, AO, AQ, AS, AU, AW, AY, BA, BD, BF, BH"
pra ocorrer a atualização. Pois da maneira como está somente se teclando Enter em:
"J, L, M, N, Q, R" que ocorre a modificação... Preciso fazer q tudo seja automático tdeu!!

Mais uma vez obrigado dsd já...

[Midori]

Não entendi o que quer fazer agora, algumas colunas que mencionou estão ocultas e sem dados.

 

Se anexar a planilha com esses exemplos vai ajudar.

[jcgmcs]

Então... é fazer "BH" ficar como está em "BF"  mas acrescido com Mês e Ano tdeu...

Ficaria tipo assim exemplos: ON SET/22+    ON JUN/18    OFF AGO/18    OFF MAI/23   ON OUT/24+

 

Midori bom dia!

Segue modelo da Planilha um pouco mais completa.

As colunas ocultas são as que não tem vínculo algum com as demais ok.

obrigado!

Excel VBA - Trazer Resultados em BA_BD_BF_BJ - MOD1 Exemplos.xls

 

OBs: Preciso dos códigos pra todas essas colunas ok!

"AM"    "AO"    "AQ"    "AS"    "AU"    "AW"    "AY"    "BA"    "BD"    "BF"    "BH"    "BJ"

[jcgmcs]

Viiixi... Midori kd você...!? rsrs

[Midori]

É só fazer as atribuições nessas colunas.

 

Para facilitar o trabalho criei dois procedimentos, então basta ir acrescentando as linhas no código com eles. É só seguir o exemplo, p.ex,

 

Para acrescentar um valor em BJ: Call Registra(Target, "BJ", "Teste")

 

E para pegar o dado de L: Resultado(Target, "L")

 

Private Sub Registra(Status As Range, Coluna As String, Valor As String)
    Dim C As Long
    
    C = Range(Coluna & ":" & Coluna).Column
    
    If C <> Status.Column Then
        Cells(Status.Row, C).Value = Valor
    End If
End Sub

Private Function Resultado(Status As Range, Coluna As String) As String
    Resultado = Cells(Status.Row, Range(Coluna & ":" & Coluna).Column).Value
End Function

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count = 1 And Target.Row >= 5 Then
        Dim Tipo    As String
        
        If Target.Column = [N:N].Column Then
            Tipo = Right(Target.Value, 2)
            If Tipo <> "ON" Then
                Tipo = Right(Target.Value, 3)
            End If
            
            Call Registra(Target, "BF", Tipo)
            Call Registra(Target, "AM", Target.Value & Format(Resultado(Target, "L"), "YYYY"))
            Call Registra(Target, "AO", Target.Value & Format(Resultado(Target, "L"), "MMM/YY"))
            
        ElseIf Target.Column = [R:R].Column Then
            Dim Ano     As String
            Dim MesAno  As String
            
            Tipo = Trim(Left(Target, InStr(Target, " ")))
            If Tipo <> "ATIVO" And Tipo <> "INATIVO" Then
                Tipo = ""
            Else
                Ano = "/" & Split(Target, "/")(2)
                MesAno = " " & Split(Target, "/")(1) & Ano
            End If
            
            Call Registra(Target, "BA", Tipo & Ano)
            Call Registra(Target, "BD", Tipo & MesAno)
            Call Registra(Target, "BJ", Tipo & Tipo)
        End If
    End If
End Sub

 

[jcgmcs]

Muito obrigado!!! Vou tentar aqui.... Abç ae rsrs

[jcgmcs]

Midori boa noite!

Amigão meus miolo já tá fumaciando aqui... rsrs

Não to conseguindo os resultados esperados  nas colunas em vermelho.

Pra cada uma delas as informações são diferentes e ae eu me embanano todo...

Por favor, te agradeço se puder montar ae esses códigos pra nós. Tá muito complexo rsrs

obrigado!!

[jcgmcs]

Será que alguém mais ae poderia nos prestar essa colaboração...?

[jcgmcs]

Socorro!!!  

[jcgmcs]

Alguém ajudaee..!!

[Midori]

Em 05/12/2024 às 22:54, jcgmcs disse:

Não to conseguindo os resultados esperados  nas colunas em vermelho.

Pra cada uma delas as informações são diferentes e ae eu me embanano todo...

Quais resultados não está conseguindo?

 

Como ficou o código com a sua edição?

[jcgmcs]

Boa tde Midori...!!!!!!

Tentei de todo jeito, sem sucesso.

No anexo setei em cores pra que entenda o que vae ser retirado e colocado...

As colunas da esquerda onde estão em Verde "J, L, M, N, Q, R" é onde serão tiradas as informações pra serem colocadas à direita em Vermelho de AM pra frente...

É só seguir ae como está na linha 118...

[jcgmcs]

OBs: Na print, me esqueci de setar a coluna "J" que também é seta Verde... e "BJ" que saiu cortada é de "R"