Este fórum está sendo desativado

[dehfausto]

Boa tarde a todos!!

Trabalho em uma empresa de óleo & gás com a gestão de indicadores de qualidade (KPIs). Atualmente, cada área tem sua planilha do Excel com os indicadores, que geram gráficos a partir dos valores que são atualizados mensalmente pelas áreas, como no exemplo da imagem:



Porém, como podem ver, o histórico é anual e todo final do ano tinhamos o trabalho de mudar isso, além de perder o acesso às informações de anos anteriores. Pensando nisso, criei uma aba nova para inserir os dados com uma tabela com varios anos e essa tabela do gráfico leria os dados dessa tabela auxiliar através do PROCH, como se fosse um mini banco de dados bastante improvisado.



Com isso, adicionei uma nova opção do usuario escolher o ano na planilha principal e então a tabela com os dados vai mudando de acordo com o ano escolhido, lendo essa aba auxiliar. Isso funcionou e a ideia foi bem aceita, porém, como em cada arquivo (são mais de 20) são mais de 15 indicadores, a aba auxiliar fica muito grande com essas tabelas grandes para todos os anos e se eu ocultar os anos que não estão sendo usados e deixar apenas o ano corrente, todo final de ano eu teria que desocultar e ocultar cada indicador.

Então pensei um novo jeito e pensei em algo feito no VBA. A ideia seria colocar um botão linkado a esse macro e quando o botão é acionado, abriria uma tela pedindo para o usuário informar o ano, o mês e o valor e esse valor seria transportado para essa tabela. E ai vem a minha dúvida.

É possivel programar esse input de dado de modo que a célula destino dele dependa do ano e do mês e o excel consiga identificar essa célula? Porque ai poderia até deixar essa aba auxiliar oculta e então o gráfico e a tabela principal (primeira imagem) leria os dados dela.

Minha explicação é muito longa, desculpe mas não tinha outro jeito de deixar claro o que preciso. Obrigado desde já pra quem tiver a disposição de ler!

[Parkeless]

Boa tarde!

Não sei se entendi bem; o que você quer é que o Excel localize uma célula, que corresponda a um determinado período informado pelo usuário através de uma inputbox? Se for isso, dá pra fazer sim... só é um pouco difícil de imaginar como seria para o seu caso, sem ter a planilha. Você não consegue postar um modelo?

[dehfausto]

Segue o anexo de um exemplo de indicador com as coisas que eu falei. A aba SMA é a aba "oficial". Nela que é gerado o report mensal para apresentações. Essa planilha lê os dados que são inputados na outra aba (Data Input) através do PROCH. Essa Data Input somente serve como uma aba auxiliar para inputar os dados pelo preenchedor e é uma forma de se formar um banco de dados. Com ela é possivel que o usuário escolha o ano na aba SMA e venha todos os dados desejados.

O que eu estava pensando era uma forma de automatizar o processo de preenchimento. Pensei em algum botão "Atualizar dados" em cada indicador e então abriria uma InputBox onde o usuário colocasse o valor e esse valor fosse automaticamente para a tabela auxiliar de acordo com o mês e ano, entende?

[Parkeless]

Então... o que você quer é que os dados sejam inseridos via VBA, sendo que a aba que contém o banco de dados ficaria oculta e o usuário só teria acesso à aba principal, certo?

Tem duas formas de fazer isso, mas tem uns poréns.

Pelo que entendi, você tem dois tipos de valores a serem inseridos: valor de target (meta), e valor efetivamente obtido no período.

Levando isso em consideração, seria possível fazer isso com uma série de inputboxes, assim:

O usuário vai clicando ok, e vai aparecendo a próxima caixa de mensagem.

Uma outra forma, mais bonitinha, seria através de inputbox, assim:

O problema dessa forma é que, se eu fizer numa planilha modelo, vai ser difícil você implantar na sua se não manjar de VBA.

Agora vamos aos poréns:

1. O ideal seria que o usuário não pudesse colocar qualquer tipo de dado no userform ou inputbox... por exemplo, em "ano", ele colocar "Parkeless". Dá para bolar algo com alguma validação básica, mas, fora isso, cada caso é um caso, depende do que sua empresa precisa...

2. Se o usuário quiser apagar alguma informação (apagar, não sobrescrever), não seria possível, a não ser que ele tivesse acesso à planilha oculta. A não ser que você quisesse usar userform pra isso também...


[EDIT]

Pensei numa forma um pouco mais simples:

Eu, como usuário, só tenho acesso à aba SMA, nem tenho conhecimento da aba oculta ok?
Digamos que eu queria adicionar o valor "2" no Realized de Janeiro de 2016. Mudo o ano para 2016, altero o conteúdo da célula G19 para "2".

Ao invés da célula G19 ser alterada, ela mantém a fórmula original, mas no banco de dados esse dado é inserido automaticamente, o que faz com que a fórmula retorne "2".

Te atenderia?

[dehfausto]

Parkeless, primeiramente muito obrigado pela atenção e resposta.

Falando das suas sugestões, seria perfeito o jeito mais simples do usuário imputar o valor na célula G19 e ela não perder a fórmula e ainda inserindo o valor no banco de dados. Porém, apesar do meu bom conhecimento de VBA (não sou um expert mas ja fiz bastante coisa. Mas manjo bem de programação e eu pego fácil as coisas de VBA), esse tipo de código eu não saberia fazer. É muito complexo? Se não, você poderia fazer um exemplo para que eu analise e aprenda?

Sobre o outro modelo, também serviria (com a inputbox). Isso é tranquilo de fazer, a minha dúvida seria como fazer pra jogar esses valores na aba oculta na célula referente ao mês e ano selecionado. O outro jeito seria melhor, mas essa também seria uma possibilidade e o jeito que você sugeriu ali estaria bom também. Sobre não poder alterar valores anteriores, isso é ótimo. As pessoas não estáo autorizadas a alterar dados dos meses anteriores (isso não é comum e deve passar pela aprovação de varias pessoas, então se isso tiver que acontecer eu mesmo mudo o valor). Também seria uma opção viável. Se você pudesse fazer um exemplo também, eu agradeceria e aprenderia com prazer. Como te disse, tenho bom conhecimento do VBA e avançado em programação e consigo pegar as coisas facilmente.

Novamente muito obrigado pela ajuda!

[Parkeless]

Então... bolei um código que ficou meio grande kkk tentei descrever ao máximo o que fiz pra você entender... bom, segue aí
Não é muito complexo, só ficou meio grande por conta das condições... mas a lógica é simples: Você altera o valor, o Excel grava esse valor, dá um CTRL + Z para a fórmula voltar, e insere esse valor no banco de dados.

É um worksheet.change, da aba SMA, ok?

Código: Selecionar todos

Option Explicit

Public Macro As Boolean 'A variante tem que ficar fora da macro, pois têm que manter seu valor

Private Sub Worksheet_Change(ByVal Target As Range)

'O método Undo executado nessa macro é considerado como um "Change", então, para evitar um loop, temos que garantir que só seja executada por uma alteração manual, não da macro.

If Macro = True Then: Exit Sub

Macro = True 'A partir daqui, é ação da macro

Application.ScreenUpdating = False


'Só executar macro se a célula alterada está entre G19:R20
On Error GoTo Fim
If Intersect(Target, Range("G19:R20")) = 0 Then: On Error GoTo 0 'se não estiver, dará erro e ele irá para Fim; se não, não faz nada

'Determinar mês e ano
Dim Ano As Long
Dim Mês As String
On Error GoTo Ano_Incorreto
Ano = Range("x11")
On Error GoTo 0
Mês = Target.EntireColumn.Rows("18")

'Determinar se alteração foi em Realized ou Target
Dim Realized As Boolean
If Target.Row = 19 Then: Realized = True

'Em relação ao valor inserido
On Error GoTo NãoValor 'Se for texto, dar erro e sair da macro
Dim Valor_Inserido As Double
'Considerações: se o texto tiver sido apagado (""), simplesmente apagar ao invés de colocar zero
Dim Zerar As Boolean
If Target = "" Then: Zerar = True
Valor_Inserido = Target 'Gravar valor inserido
On Error GoTo 0
Application.Undo 'Retornar fórmula à aba SMA

'Verificar se o ano informado já foi utilizado
Dim Já_tem_ano As Boolean
Dim Confirmação As String
Dim i As Long
For i = Sheets("Data Input").Range("B1000000").End(xlUp).Row To 1 Step -1
    If Sheets("Data Input").Cells(i, 2) = Ano Then
        Já_tem_ano = True
        GoTo Jump 'Pular, só para não ter que continuar procurando depois de achar
    End If
Next i
Jump:
If Já_tem_ano = False Then 'Se não tiver, criar [obs.: vi depois que há uma validação para anos, então essa parte é irrelevante... portanto, não testei]
    Confirmação = MsgBox("The year " & Ano & "was not found, do you want to create?", vbYesNo, "Confirmation")
        If Confirmação = vbYes Then
            Sheets("Data Input").Range("B1000000").End(xlUp).Offset(1, 0) = Ano
            Sheets("Data Input").Range("B1000000").End(xlUp).Offset(1, 0) = Ano & " Target"
            MsgBox "The year " & Ano & "was created."
        Else
            GoTo Fim
        End If
End If

'Parte final: inserir o valor.
Dim Linha As Long, Coluna As Long 'Determinar linha e coluna de inserção
'Usar o CORRESP para achar
On Error GoTo FatalError 'Não é pra dar erro aqui... se der, o desenvolvedor deve verificar
Linha = Application.WorksheetFunction.Match(Ano, Sheets("Data Input").Range("B:B"), 0)
Coluna = Application.WorksheetFunction.Match(Mês, Sheets("Data Input").Rows("4:4"), 0)
On Error GoTo 0
'Se for target, vai ser uma linha abaixo do ano
If Realized = False Then: Linha = Linha + 1

'Analizar célula de alteração: Já tem valor ali? Se tiver, só permitir alteração através de senha
Dim Senha As String
If Sheets("Data Input").Cells(Linha, Coluna) <> "" Then
    Senha = Application.InputBox("The month " & Mês & " of the year " & Ano & " have values already!" & vbNewLine & "To modify it, please insert the password", "Modifying")
        If Senha <> "Parkeless" Then
            MsgBox "Invalid password.", vbCritical
            GoTo Fim
        End If
    On Error GoTo 0
End If

'Enfim, colocar dados
If Zerar = True Then
    Sheets("Data Input").Cells(Linha, Coluna) = ""
Else
    Sheets("Data Input").Cells(Linha, Coluna) = Valor_Inserido
End If


Macro = False 'A partir daqui, deixa de ser ação da macro

Exit Sub

'--------- Área de Erros ----------'

FatalError:
MsgBox ("Erro inesperado!"), vbCritical
GoTo Fim

Ano_Incorreto:
MsgBox ("Erro: ano inválido!"), vbCritical
GoTo Fim


NãoValor:
Application.Undo
MsgBox ("Erro: Você só pode incluir valores nessa célula!"), vbCritical
GoTo Fim


Fim:
Macro = False
Application.ScreenUpdating = True
End Sub

Estou anexando a planilha com a aplicação.

Observações:
1. A senha de edição é Pakeless; você consegue editar no código.
2. Tem um probleminha na sua fórmula na coluna AD, e o ano 2020 está puxando com erro; corrigi na planilha anexa.
3. No próprio código tem material de estudo para você ver como restringir alterações de usuários, e também como dizer ao Excel onde ele deve colocar o valor, baseado no critério de Ano e Mês (eu usei o CORRESP - ou MATCH - porque me pareceu ser melhor nesse caso, mas tem outras formas).

[dehfausto]

Bom dia Parkeless.

Baixei o arquivo aqui e só posso dizer que ficou sensacional!

Muito bem explicado. Estou analisando cada linha do código para entender perfeitamente cada linha e vendo se consigo fazer todas as modificações para adaptar o código para os outros indicadores.

Depois que acabar de ver tudo caso fique alguma dúvida eu venho aqui te perturbar de novo. Se não, te aviso e deixo o tópico como resolvido.

Novamente muito obrigado!

[dehfausto]

Parkeless, consegui entender tudo muito bem. Modifiquei o código para testar em outro indicador e consegui. Porém, não consigo fazer funcionar quando há mais de um indicador na planilha, como em anexo.

Acho que fiz todas as modificações necessárias para que funcionasse na range do indicador 1.2, mas não funciona.
Outro problema que eu acho que teria é na hora de localizar a célula correspondente na aba do Data Input.

O código faz o CORRESP desse jeito, certo?

Linha = Application.WorksheetFunction.Match(Ano, Sheets("Data Input").Range("B:B"), 0)
Coluna = Application.WorksheetFunction.Match(Mês, Sheets("Data Input").Rows("4:4"), 0)

A coluna não teria problema pois os meses são os mesmos pra todos anos, porém acrescentando outros indicadores, o mesmo ano se repetirá ao longo da coluna B. Existe um meio dele diferenciar isso, tipo restringindo a range de procura para cada indicador, tipo o PROCH?

Agradeço novamente se puder dar uma olhada!

Obs: Tirei o erro pra quando fosse deletado o valor, pois apesar de não poder ser feito, as vezes durante o processo de atualização as pessoas precisam corrigir os valores antes de fechar o mês. Mas não tem problema, deixa sem mesmo.

[dehfausto]

Opss, esqueci de anexar

[Parkeless]

Então... você adicionando novos critérios dessa forma, altera bastante ^^'

Dei uma mexida, agora você deve conseguir inclusive incluir novos critérios... mas com uma ressalva

Notei que alguns dados saíram do lugar em relação ao primeiro anexo que você mandou; acho que você adicionou algumas linhas no início. Tentei redefinir o código para ele ser o mais relativo possível... mas mesmo assim, fica o conselho: o código foi feito para a formatação atual. Se você incluir ou excluir linhas ou colunas, ou algo do tipo, você está correndo o risco do código parar de funcionar. O ideal é que você disponibilize um modelo fiel da sua planilha para montarmos o código, porque, bom, ele foi feito para aquilo ali.

Se for para incluir novos dados, "inputs", tenha sempre isso em mente; em relação a Layout, muito cuidado.

Dá uma olhada agora e me fala.

Novo código:

Código: Selecionar todos

Option Explicit


Public Macro As Boolean 'A variante tem que ficar fora da macro, pois têm que manter seu valor

Private Sub Worksheet_Change(ByVal Target As Range)

'O método Undo executado nessa macro é considerado como um "Change", então, para evitar um loop, temos que garantir que só seja executada por uma alteração manual, não da macro.

If Macro = True Then: Exit Sub

Macro = True 'A partir daqui, é ação da macro

Application.ScreenUpdating = False


'Só executar macro se a célula alterada está entre as colunas G e R
If Target.Column >= 7 And Target.Column <= 18 Then
    If Trim(Cells(Target.Row, 6)) = "Realized" And Trim(Cells(Target.Row, 6)) = "Target (<=)" Then: GoTo Fim
Else
    GoTo Fim
End If

'If Intersect(Target, Range("G19:R20")) = 0 Then: On Error GoTo 0 'se não estiver, dará erro e ele irá para Fim; se não, não faz nada [retirado]


'Determinar mês e ano [editado... são relativos agora. Pego mês mais para frente]
Dim Ano As Long
Dim Mês As String
On Error GoTo Ano_Incorreto
Ano = Cells.Find(What:="Report year:", After:=Range("A1"), LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Offset(0, 1)
On Error GoTo 0

'Determinar se alteração foi em Realized ou Target; aproveitar para pegar o endereço da célula com o texto "Realized"
Dim i As Long
Dim Realized As Boolean
Dim Célula_Realized As Range

If Trim(Cells(Target.Row, 6)) = "Realized" Then
    Realized = True
    Set Célula_Realized = Cells(Target.Row, 6)
Else
    Set Célula_Realized = Cells(Target.Row - 1, 6)
End If

Jump2:
'Mês
Mês = Cells(Célula_Realized.Row - 1, Target.Column)


'If Target.Row = 19 Then: Realized = True [retirado]

'Em relação ao valor inserido
On Error GoTo NãoValor 'Se for texto, dar erro e sair da macro
Dim Valor_Inserido As Double
'Considerações: se o texto tiver sido apagado (""), simplesmente apagar ao invés de colocar zero
Dim Zerar As Boolean
If Target = "" Then: Zerar = True
Valor_Inserido = Target 'Gravar valor inserido
On Error GoTo 0
Application.Undo 'Retornar fórmula à aba SMA

'[new] Determinar indicador
Dim Indicador As String
Indicador = Left(Célula_Realized.Offset(-4, -3), 3)



'Verificar se o ano informado já foi utilizado
Dim Já_tem_ano As Boolean
Dim Confirmação As String
For i = Sheets("Data Input").Range("B1000000").End(xlUp).Row To 1 Step -1
    If Sheets("Data Input").Cells(i, 2) = Ano Then
        Já_tem_ano = True
        GoTo Jump 'Pular, só para não ter que continuar procurando depois de achar
    End If
Next i
Jump:
If Já_tem_ano = False Then 'Se não tiver, criar [obs.: vi depois que há uma validação para anos, então essa parte é irrelevante... portanto, não testei]
    Confirmação = MsgBox("The year " & Ano & "was not found, do you want to create?", vbYesNo, "Confirmation")
        If Confirmação = vbYes Then
            Sheets("Data Input").Range("B1000000").End(xlUp).Offset(1, 0) = Ano
            Sheets("Data Input").Range("B1000000").End(xlUp).Offset(1, 0) = Ano & " Target"
            MsgBox "The year " & Ano & "was created."
        Else
            GoTo Fim
        End If
End If

'Parte final: inserir o valor.
Dim Linha As Long, Coluna As Long 'Determinar linha e coluna de inserção
'Usar o CORRESP para achar
On Error GoTo FatalError 'Não é pra dar erro aqui... se der, o desenvolvedor deve verificar
Dim x As Long
For i = Sheets("Data Input").Range("B1000000").End(xlUp).Row To 1 Step -1
    If Trim(Left(Sheets("Data Input").Cells(i, 2), 4)) = Indicador Then
        For x = i + 3 To Sheets("Data Input").Cells(i, 2).Offset(2, 0).End(xlDown).Row
            If Sheets("Data Input").Cells(x, 2) = Ano Then
                Linha = Sheets("Data Input").Cells(x, 2).Row
                GoTo Jump3
            End If
        Next x
    End If
Next i
            
Jump3:
'Linha = Application.WorksheetFunction.Match(Ano, Sheets("Data Input").Range("B:B"), 0) [retirado]
Coluna = Application.WorksheetFunction.Match(Mês, Sheets("Data Input").Rows("4:4"), 0)
On Error GoTo 0
'Se for target, vai ser uma linha abaixo do ano
If Realized = False Then: Linha = Linha + 1

'Analizar célula de alteração: Já tem valor ali? Se tiver, só permitir alteração através de senha
Dim Senha As String
If Sheets("Data Input").Cells(Linha, Coluna) <> "" Then
    Senha = Application.InputBox("The month " & Mês & " of the year " & Ano & " have values already!" & vbNewLine & "To modify it, please insert the password", "Modifying")
        If Senha <> "Parkeless" Then
            MsgBox "Invalid password.", vbCritical
            GoTo Fim
        End If
    On Error GoTo 0
End If

'Enfim, colocar dados
If Zerar = True Then
    Sheets("Data Input").Cells(Linha, Coluna) = ""
Else
    Sheets("Data Input").Cells(Linha, Coluna) = Valor_Inserido
End If


Macro = False 'A partir daqui, deixa de ser ação da macro

Exit Sub

'--------- Área de Erros ----------'

FatalError:
MsgBox ("Erro inesperado!"), vbCritical
GoTo Fim

Ano_Incorreto:
MsgBox ("Erro: ano inválido!"), vbCritical
GoTo Fim


NãoValor:
Application.Undo
MsgBox ("Erro: Você só pode incluir valores nessa célula!"), vbCritical
GoTo Fim


Fim:
Macro = False
Application.ScreenUpdating = True
End Sub

[dehfausto]

Antes de mais nada, mais uma vez muito obrigado!

O código parece perfeito. Dei uma rapida olhada agora mas ja estou saindo da empresa, então vou dar uma olhada linha por linha hoje mais tarde em casa e te falo como foi.

Quanto ào acréscimo das linhas, eu alterei no macro também as linhas que mudaram. Eu tive que acrescentar o cabeçalho, pois no modelo anterior que você tinha trabalhado estava sem. Essa é a versão final e igual a todos arquivos, variando apenas o número de indicadores em cada um deles.

Com esse novo código, eu consigo ajustar para quantos indicadores forem necessários, certo?

[Parkeless]

Entendi. Ah, então, beleza... eu fiz as alterações a partir do código que eu tinha feito, então não peguei suas alterações.

Sim, tentei deixar de forma que você possa adicionar quantos indicadores quiser. Mas para ele achar qual é o indicador, mandei o código procurar a célula que contém o texto "Realized" próximo à célula alterada, e a partir daí pegar o número do indicador mais próximo; por isso ressaltei o cuidado com alterações na estrutura.



Bom, testa incluindo/removendo indicadores; se tiver algum problema me avise.