Este fórum está sendo desativado

[SandroLima]

Bom dia, pessoal.

Tenho uma tabela com 4 colunas
1) Data
2) Item
3) Data Nasc / Compra
4) Código

Tenho uma macro que cada vez que uma nova linha é inserida executa o seguinte código:

Código: Selecionar todos

With Tabela_AtvDiarias.ListColumns("Código").DataBodyRange
        .Rows("2:" & .Rows.Count - 1).Value2 = .Rows("2:" & .Rows.Count - 1).Value2
End With

Preciso inserir algumas condições para executar essa parte da macro... são elas:
- executar somente se os campos da coluna "Data" forem diferentes de vazio ("") ou diferentes de "-";
- somente se o valor da coluna "Item" for igual a "Paciente";
- e somente se a coluna "Data Nasc / Compra" tiver uma data preenchida.

Como ficaria a implementação dessas condições nesse trecho do código?

Obrigado a quem puder colaborar. Tenham um bom dia.

[SandroLima]

Anexo planilha para teste.

[SandroLima]

Bom dia.

Alguém poderia me ajudar?

[SandroLima]

Bom dia.

Alguém!?!?!

[osvaldomp]

... cada vez que uma nova linha é inserida ...
Em que linha/posição/altura a linha é inserida ?
Como a linha é inserida (manual, via código) ?

- executar somente se os campos da coluna "Data" forem diferentes de vazio ("") ou diferentes de "-";
Não seria "executar somente se o campo da coluna "Data" for diferente de vazio ("") E diferente de "-" " ?
Ainda, campo de qual linha ?

- somente se o valor da coluna "Item" for igual a "Paciente"; ~~~> de qual linha ?

- e somente se a coluna "Data Nasc / Compra" tiver uma data preenchida. ~~~> de qual linha ?

dica - você disponibilizou uma planilha com 300+ linhas com dados; uma planilha com 4 a 5 linhas com dados seria o suficiente (menos trabalho pra você e mais simples pra quem tentar ajudar)

[SandroLima]

Boa tarde, Osvaldomp.

A linha é inserida através da macro do botão "Inserir Nova Linha".

A cada vez que a macro é executada ela replica a fórmula da coluna "Código" para a nova linha inserida. Preciso que cada vez que isso aconteça que o código verifique e execute para cada linha da tabela que:
- se o campo "Data" for diferente de vazio ("") ou de "-",
- se o campo da coluna "Item" for igual a "Paciente"
- e somente se a coluna "Data Nasc / Compra" tiver uma data preenchida.

Ele então execute a parte do código:

Código: Selecionar todos

With Tabela_AtvDiarias.ListColumns("Código").DataBodyRange
        .Rows("2:" & .Rows.Count - 1).Value2 = .Rows("2:" & .Rows.Count - 1).Value2
End With

na linha respetiva da coluna "Código" que atende as condições acima.

A finalidade seria a de "fixar" o valor do campo "código" referente aos itens "Paciente" quando uma nova linha for inserida. Aplicarei essa rotina em outras macros também como uma que faz "Parcelamentos" e outra que insere atividades mensais recorrentes e preciso fixar o código a cada linha inserida.

Da maneira que está o código do item "Paciente" muda a cada vez que uma nova linha é inserida pois o item pode variar a posição da linha na tabela à medida que novos itens são acrescentados.

[osvaldomp]

Tentando ainda entender o que você quer fazer.

A cada vez que a macro é executada ela replica a fórmula da coluna "Código" para a nova linha inserida.
Me parece que a fórmula é replicada automaticamente ao inserir linha na Tabela. A sua macro só insere fórmula na coluna "Dia da Semana", o que não precisaria fazer pois a linha inserida automaticamente já terá a fórmula.

Preciso que cada vez que isso aconteça que o código verifique e execute para cada linha da tabela que:
- se o campo "Data" for diferente de vazio ("") ou de "-",
- se o campo da coluna "Item" for igual a "Paciente"
- e somente se a coluna "Data Nasc / Compra" tiver uma data preenchida.
Ele então execute a parte do código:
Um exemplo: se o código que você está querendo elaborar encontrar na terceira linha da Tabela as condições que atendam aos critérios acima então você quer rodar o trecho de código abaixo, é isso?
Se sim, ao rodar o trecho de código abaixo, da linha 2 até a penúltima linha da Tabela, TODAS as fórmulas da coluna "Código" serão substituídas pelos seus respectivos valores.
Aí, continuando o Loop, se o novo código encontrar na sexta linha da Tabela as condições que atendam aos critérios acima então você quer rodar de novo o trecho de código abaixo, é isso?
Se sim, não faz sentido pois já não haverá fórmulas a serem substituídas pelos seus valores.
Qual a lógica de fazer um Loop percorrer 300+ linhas e rodar um código pra fazer o que já está feito?
Ou estou no caminho errado?

Código: Selecionar todos

With Tabela_AtvDiarias.ListColumns("Código").DataBodyRange
        .Rows("2:" & .Rows.Count - 1).Value2 = .Rows("2:" & .Rows.Count - 1).Value2
End With

na linha respetiva da coluna "Código" que atende as condições acima.
O trecho do código acima não atua somente em uma linha, conforme comentei antes.

Da maneira que está o código do item "Paciente" muda a cada vez que uma nova linha é inserida pois o item pode variar a posição da linha na tabela à medida que novos itens são acrescentados.
Não entendi esta parte.

[SandroLima]

Boa noite, Osvaldomp.

Vou tentar esclarecer melhor... mas se você tiver uma outra ideia pode ser que EU esteja no caminho errado.

Me parece que a fórmula é replicada automaticamente ao inserir linha na Tabela.

Sim... é isso mesmo. Isso é desejado para toda nova linha que for inserida.

A sua macro só insere fórmula na coluna "Dia da Semana", o que não precisaria fazer pois a linha inserida automaticamente já terá a fórmula.

Isso também se torna necessário (caso haja alteração do campo data de algum dos eventos posteriormente, ele corrige automaticamente o dia da semana).

A fórmula da coluna "Código" como pode perceber gera valores únicos para os "Itens" denominados "pacientes".

Os códigos gerados são compostos por partes das colunas "Registro", "Data", "Nome / Razão Social" e "Data Nasc / Compra".

Suponhamos que tenha um paciente cujo Registro seja 108 e que tenha gerado para ele o seguinte código:
08 - xxx.xxxx.xxx
Pode ser que esse número de registro mude conforme a ordem em que as novas linhas assumam na tabela... o Registro dele pode passar a ser 129 por exemplo e o código passaria a ser:
29 - xxx.xxxx.xxx

Da maneira que está o código do item "Paciente" muda a cada vez que uma nova linha é inserida pois o item pode variar a posição da linha na tabela à medida que novos itens são acrescentados.
Não entendi esta parte.

O número de registro pode mudar pois tenho uma macro que reordena as linhas da tabela conforme a data e o cumprimento de alguns quesitos (a tabela possui outras colunas que não possuem efeito para essa atividade aqui postulada).

Dito isso, preciso de uma macro ou parte de um código que fixe esse "Código" caso as condições citadas anteriormente sejam cumpridas mas mantenha a fórmula caso ainda não tenham sido atendidas.

Atualmente eu utilizo aquele trecho do código para cada linha nova inserida e ele copia e cola os valores desde a segunda linha até a última linha,porém me deparei com um problema.
Pode acontecer de nem todos as condições que citei para que rodasse a macro serem atendidas em um primeiro momento.

Explico: Inseri uma nova linha e em alguma linha anterior ainda que sendo um item "paciente" o campo data estava preenchido porém eu ainda não tinha a informação por exemplo sobre a "Data de Nasc".
Nessa situação após eu obter posteriormente a data de nascimento eu precisaria aplicar a fórmula novamente no campo da coluna código para então obter o código desse paciente já que não existia mais a fórmula nesse campo pois foi substituído anteriormente pela macro mesmo sem todos os dados/quesitos que compõem o "código" desse "paciente'

Preciso que o código então substitua as fórmulas pelos valores caso as condições tenham sido atendidas... porém os códigos que já foram fixados não devem mais ser alterados (lembrando que os números de registro podem mudar e isso não deve alterar um código já "gerado/fixado").

Não sei se esse é o melhor caminho... se você tiver uma ideia melhor será bem vinda.

Essa necessidade de "códigos" únicos é porque esses dados depois são copiados para uma outra planilha em que são enviados somente novos "códigos" eliminando dados em duplicidade.
Nessa macro os códigos que já foram copiados não são copiados novamente desse modo preciso que os códigos uma vez gerados (que tenham a fórmula substituída pelo valor) não sejam mais modificados para que nenhuma informação seja perdida ou transportada em duplicidade.

Imagine a situação em que um paciente possui um dado código mas que por algum motivo a ordem na tabela alterou e com isso seu registro também e consequentemente o seu código também alteraria. Diante disso caso eu tenha transportado esse código para a outra planilha e posteriormente o código altere vou levar a mesma informação para a outra planilha novamente ainda que sejam códigos diferentes (isso não deve ocorrer)

A solução de usar CPF ou nome para transportar valores únicos não serve pois um mesmo paciente pode receber mais de um tipo de atendimento no mesmo dia e com isso temos dois registros/códigos diferentes (e os dois devem ser transportados para a outra planilha).

A explicação ficou bem longa mas tentei colocar a minha necessidade da maneira mais clara possível.Qualquer dúvida pode continuar perguntando. Tento melhorar a explicação.

Muito obrigado e boa noite.

[SandroLima]

Bom dia.

Me foi apresentada a seguinte alternativa:

Código: Selecionar todos

Dim i As Long
 Dim Ultcod As Long

 Ultcod = wshAtivDiarias.Cells(Rows.Count, 2).End(xlUp).Row

 For i = 15 To Ultcod

     If (wshAtivDiarias.Cells(i, 8) <> "-") Then
                wshAtivDiarias.Cells(i, 8).Select
                Selection.Copy
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False

     Else
     End If

 Next

Vou testar.

[SandroLima]

Parece funcionar.

Mas o tempo de execução fica excessivamente longo.

[osvaldomp]

A cada vez que a macro é executada ela replica a fórmula da coluna "Código" para a nova linha inserida.
Me parece que a fórmula é replicada automaticamente ao inserir linha na Tabela. A sua macro só insere fórmula na coluna "Dia da Semana", o que não precisaria fazer pois a linha inserida automaticamente já terá a fórmula.

O que eu quis dizer com o texto em azul acima é que é equivocada a sua afirmação de que o seu código insere fórmula na coluna Código, pois não existe tal comando no seu código. A fórmula é inserida automaticamente pelo Excel em decorrência da inserção de linha na Tabela, o que ocorre também se a inserção for feita manualmente.
Por outro lado o seu código insere fórmula na coluna Dia da Semana, o que é desnecessário pela razão exposta acima.

Ainda, me parecem desnecessários os comandos Application.EnableEvents = False e On Error Resume Next, mais que isso, é desaconselhável a utilização do primeiro, no seu caso.

Veja se o código abaixo te ajuda.

Código: Selecionar todos

...
Dim x As Long ~~~> acrescente às declarações já existentes
...
  For x = 1 To Tabela_AtvDiarias.Range.Rows.Count
   If IsDate(Tabela_AtvDiarias.ListColumns("Data").DataBodyRange.Cells(x, 1).Value) And _
    Tabela_AtvDiarias.ListColumns("Item").DataBodyRange.Cells(x, 1).Value = "Paciente" And _
    IsDate(Tabela_AtvDiarias.ListColumns("Data Nasc / Compra").DataBodyRange.Cells(x, 1).Value) Then
    
   'coloque aqui as instruções que você desejar
   
   End If
  Next x
...

[SandroLima]

Boa tarde, Osvaldomp e demais usuários e colaboradores do fórum.

Ainda, me parecem desnecessários os comandos Application.EnableEvents = False e On Error Resume Next, mais que isso, é desaconselhável a utilização do primeiro, no seu caso.

Estou seguindo as recomendações e tirei essas linhas do código.
Vinha replicando outros códigos e vou estudar mais sobre quando esses comandos são realmente necessários.

Adaptei o seu código e aparentemente funcionou bem exceto para duas linhas da tabela que eu não soube entender o motivo.
Clique no botão"Inserir Linha" e perceba que as linha dos registros 308 e 439 a fórmula não é substituída pelos valores.

Indo já mais adiante:

Parece funcionar.

Mas o tempo de execução fica excessivamente longo.

Sobre a lentidão que eu mencionei e fazendo o teste passo a passo percebi que a lentidão em executar a macro "InserirLinha" deve-se não ao código próprio da macro mas ao código existente na Plan "ATIVIDADES DIÁRIAS" que deixei na forma comentada para não atrapalhar a verificação do "bug" mencionado anteriormente.

Código: Selecionar todos

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
    
    'If wshAtivDiarias.Range("MesReferencia_AD").Address = Target.Address Or _
        'wshAtivDiarias.Range("AnoReferencia_AD").Address = Target.Address Then
        
        'wshConfig.Range("MesReferencia_Config").Value2 = wshAtivDiarias.Range("MesReferencia_AD").Value2
        'wshConfig.Range("AnoReferencia_Config").Value2 = wshAtivDiarias.Range("AnoReferencia_AD").Value2
        
    '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
   
    'Application.ScreenUpdating = True
    
End Sub

A lentidão acontece pq ele faz uma verificação de cada linha da tabela nessa macro mesmo não havendo alteração no "targets" :
"MesReferencia_AD" / "AnoReferencia_AD" / "Consulta_Data"

Segue a planilha para verificação. Poderia me orientar como proceder?

[osvaldomp]

... as linha dos registros 308 e 439 a fórmula não é substituída pelos valores.
O código que passei detecta os critérios nas linhas citadas, que correspondem às linhas 5 e 9 da Tabela, ou seja, está funcionando corretamente. No entanto, se as fórmulas não estão sendo substituídas então revise as instruções que você acrescentou.

Indo já mais adiante:

Parece funcionar.
Mas o tempo de execução fica excessivamente longo.

Eu sugiro que você discuta isso com quem lhe passou o código.

[SandroLima]

O código que passei detecta os critérios nas linhas citadas, que correspondem às linhas 5 e 9 da Tabela, ou seja, está funcionando corretamente. No entanto, se as fórmulas não estão sendo substituídas então revise as instruções que você acrescentou.

Fiz isso... justamente por isso constatei onde não estão sendo substituídas as fórmulas. O motivo infelizmente não detectei.

Eu sugiro que você discuta isso com quem lhe passou o código.

Fiz baseado em dicas do fórum e modelos aqui postados.

De qualquer forma obrigado.

Deixo o tópico em aberto caso hajam mais sugestões.