Ir ao conteúdo
  • Cadastre-se

Excel Unir conteúdo de colunas depois de teste logico


Ir à solução Resolvido por Visitante,

Posts recomendados

Olá pessoal!

 

Alguém pode me dar uma grande ajuda?

Tenho uma planilha de atendimento de pacientes, e ela contém o número do paciente, a data que ele recebeu atendimento, e o que foi escrito pelos médicos nas colunas C e D (sendo a coluna C como um campo de formulário, e a coluna D o que foi escrito em cada campo). O @consulta, @testedelc, etc, são os nomes dos formulários.

Preciso de ajuda para criar uma função ou vba que faça o seguinte:

valide se o paciente é o mesmo e é a mesma data (colunas F e G contem a informações de paciente e data sem duplicidade), e então concatene ou una o texto de tudo que está dentro desse "período' numa mesma célula.

Ex: paciente 1 fez uma @consulta dia 22/10/2002 (a data está invertida na planilha) e foi preenchido todos os campos Queixas, Ap:, Af:,.... com as respectivas informações na coluna D. Vejam que nas colunas A e B os números dos pacientes e as datas se repetem

Eu preciso que fique assim:

paciente   data                   conteudo

1               22/10/2002        @consulta

                                           QUEIXAS: VEIO PARA CHECK UP E ACHA QUE CO EM  USO ESTÁ FORTE

                                           AP:

                                           AF: 

                                           ....

1              12/05/2014        @consulta 

                                           QUEIXAS: QUER TENTAR LC. JÁ USOU NO PASSDO A GELATINOSA

                                           AP:

                                           AF: glaucoma

                                           -----

*tudo que é correspondente ao conteúdo, tem que ficar numa mesma célula (a formatação dessa célula não é importante)

 

Se alguém puder me ajudar, agradeço.

O arquivo de base foi anexado.

 

Observação: Eu já tentei as funções UNIRTEXTO e CONCATENAR mas ela não funcionan bem dentro de um =SE(E(...))

pacientes.xlsx

Link para o comentário
Compartilhar em outros sites

 

Experimente:

Sub ConcatDados()
 Dim k As Long, x As Long, v As Long, LR As Long
  LR = Cells(Rows.Count, 6).End(3).Row
  For k = 2 To Cells(Rows.Count, 1).End(3).Row
   If Application.CountIfs(Range("F2:F" & LR), Cells(k, 1), Range("G2:G" & LR), Cells(k, 2)) Then
    x = Application.CountIfs([A:A], Cells(k, 1), [B:B], Cells(k, 2))
    With Sheets("Concat")
     .Cells(Rows.Count, 3).End(3).Offset(1, -2) = Cells(k, 1)
     .Cells(Rows.Count, 3).End(3).Offset(1, -1) = DateValue(Format(Cells(k, 2), "0000\/00\/00"))
     For v = k To k + x - 1
      .Cells(Rows.Count, 3).End(3)(2) = Trim(Cells(v, 3) & " " & Cells(v, 4).Formula)
     Next v
    End With
   End If
   k = k + x - 1
  Next k
End Sub

 

obs.

1. antes de rodar o código insira uma planilha vazia no seu arquivo e nomeie-a Concat, o resultado será lançado nela pelo código

2. ao rodar o código a planilha ativa deverá ser a planilha que contém os dados, no seu exemplo Plan3 (2)

Link para o comentário
Compartilhar em outros sites

Olá Osvaldomp

 

Rodei seu código e a coluna Descrição recebeu os textos concatenados das colunas C:D, porém cada linha ficou separada.

Eu preciso que concatene tudo de C:D numa única célula, se as informações dessas colunas pertencerem a um mesmo paciente numa mesma data, conforme o exemplo:

image.thumb.png.da480b3a087b6a7a63ae045df5d44241.png

 

Eu tentei a fórmula no excel mais atualizado, mas só uni se eu selecionar o que vai ser unido:

=SE(E((Tabela5[@PRONTUARIO]=Tabela4[@PRONTUARIO]);(Tabela5[@DATA]=Tabela4[@DATA]));UNIRTEXTO(" ";VERDADEIRO;C2:C18;D2:D18);" ")

**transformei as informações base em Tabela4 e as infos das colunas F:G em Tabela5

 

Testei também outras variações da fórmula como abaixo, e retorna #NOME?:

=SE(E((Tabela5[@PRONTUARIO]=Tabela4[@PRONTUARIO]);(Tabela5[@DATA]=Tabela4[@DATA]));UNIRTEXTO(" ";VERDADEIRO;Tabela4[[#Tudo];[ATRIBUTO]];Tabela4[[#Tudo];[DESCRICAO]]);" ")

 

Se puder me ajudar de novo, agradeço!

Link para o comentário
Compartilhar em outros sites

  • Solução

Olá, Mariana.

Desculpe, foi desatenção minha pois já no seu primeiro post está claro que deveria ser em uma única célula para cada paciente.

Experimente o código abaixo no lugar do anterior.

 

Se você quiser uma solução via fórmula, então aguarde pois talvez algum colega aqui do fórum possa lhe oferecer alguma sugestão.


 

Sub ConcatDadosV2()
 Dim k As Long, x As Long, v As Long, LR As Long, c As Long, d As Long
  LR = Cells(Rows.Count, 6).End(3).Row
  c = Columns(3).ColumnWidth: d = Columns(4).ColumnWidth * 1.4
  For k = 2 To Cells(Rows.Count, 1).End(3).Row
   If Application.CountIfs(Range("F2:F" & LR), Cells(k, 1), Range("G2:G" & LR), Cells(k, 2)) Then
    x = Application.CountIfs([A:A], Cells(k, 1), [B:B], Cells(k, 2))
    With Sheets("Concat")
     .Columns(3).ColumnWidth = c + d
     .Cells(Rows.Count, 3).End(3).Offset(1, -2) = Cells(k, 1)
     .Cells(Rows.Count, 3).End(3).Offset(1, -1) = DateValue(Format(Cells(k, 2), "0000\/00\/00"))
     .Columns("A:B").VerticalAlignment = xlCenter
     .Columns(2).AutoFit
      With .Cells(Rows.Count, 3).End(3)(2)
       For v = k To k + x - 1
        .Value = .Value & (Trim(Cells(v, 3) & " " & Cells(v, 4).Formula)) & Chr(10)
       Next v
      End With
    End With
   End If
   k = k + x - 1
  Next k
End Sub

 

Link para o comentário
Compartilhar em outros sites

Olá Osvaldomp, bom dia.

 

Apenas uma dúvida: essa macro tem limite de linhas para executar? Eu estou tentando executá-la numa planilha de 100000 linhas e trava. 

Será que o travamento está relacionado ao desempenho do computador, ou a macro em si?

 

Mais uma vez, agradecerei imensamente se puder me responder.

Link para o comentário
Compartilhar em outros sites

Olá,Mariana.

 

A macro não tem um limite pré estabelecido, ela processa os dados a partir da linha 2 e até a última linha preenchida na coluna A.

Ao ocorrer o travamento o Excel exibe alguma mensagem? É possível verificar em qual linha do código houve o travamento?

Se sim, aproveite para pairar com o cursor do mouse sobre a variável "k" e veja o valor dela, esse valor indica a linha da planilha que estava sendo processada ao ocorrer o travamento, aí verifique se há algo estranho na linha indicada ou em alguma das células referentes àquele paciente.

 

Se for possível disponibilize o arquivo completo com a macro, antes será preciso compactá-lo (zip, zipx, rar, 7z).

Link para o comentário
Compartilhar em outros sites

Osvaldomp, 

O arquivo original tem mais de 11 milhões de linhas, e por causa do limite do Excel comecei separando de 1 em 1 mi e travou, diminui para 100000, depois para 1000 e continuou travando.

A tela fica toda branca e com mensagem de que o Excel não está respondendo (uso a versão 2013 32bits num pc com Win10, 8GB de RAM, core i3). Mesmo após 6h de execução, continua travado. Não consigo acessar a macro pois não aceita nenhum comando, exceto o de fechar o programa ou continuar aguardando.

Estou enviando a planilha já dividida, com mais de 86000 linhas.

 

Obrigada

1-397.zip

Link para o comentário
Compartilhar em outros sites

Em 13/08/2020 às 17:10, Mariana Alves disse:

 ... valide se o paciente é o mesmo e é a mesma data (colunas F e G contem a informações de paciente e data sem duplicidade)

 

Olá, Mariana.

Nesse seu segundo arquivo não existe na planilha uma tabela em F:G como a que você descreveu acima, e é por isso que o código fica "zureta", pois ele não consegue dados para validar o paciente.

O primeiro código abaixo é cópia do anterior, porém desativei o comando que faz a validação do paciente, ou seja, ele não irá procurar dados nas colunas F:G. Se aquela tabela ainda for necessária então coloque-a nas colunas que você desejar e aí farei os ajustes no código. Com o fim de reduzir o tempo de execução alterei o código para processar com o cálculo no modo manual e também não atualizar a tela.

 

No segundo código abaixo fiz uma abordagem um pouco diferente e me parece que o tempo de execução é menor em cerca de 35%. Para seus testes e controles o primeiro código irá colocar em E13 o tempo gasto em segundos e a quantidade de registros processados. O segundo irá colocar em E3. Para excluir basta desabilitar a penúltima linha dos códigos.

Aqui na minha máquina (processador antigo e só 4 GB de RAM ... equivale a um Fusca 66) o primeiro código levou 251 seg / 86415 registros (V2) e o segundo 162 seg / 86415 registros (V3). Se aparecer "não respondendo" na barra superior mesmo assim deixe processar, mas não deverá demorar mais do que 5 minutos para os 86.000+ registros.

 

Vi que no seu arquivo você colocou o código no módulo de EstaPasta_de_trabalho. Embora também funcione ali, é recomendável colocá-lo em um módulo comum ~~~> menu Inserir / Módulo. Sugiro que você coloque um dos códigos abaixo no Módulo1 e o outro no Módulo2.

 

Lembrete sobre as formas de rodar um código colocado em um módulo comum:

1. tecle 'Alt+F8' / selecione a macro correspondente / Executar, ou

2. insira um botão (ou uma Forma ou uma figura) na planilha e vincule-o à macro, ou

3. vincule a macro a um atalho de teclado (Alt+F8 / Opções).
Essas três opções para rodar o código podem ser implantadas isoladamente ou em conjunto.

 


V2 alterado

Sub ConcatDadosV2()
 Dim k As Long, x As Long, v As Long, LR As Long, c As Long, d As Long
  Dim t1 As Date, t2 As Date
  t1 = Timer()
  LR = Cells(Rows.Count, 6).End(3).Row
  c = Columns(3).ColumnWidth: d = Columns(4).ColumnWidth * 1.4
  Application.Calculation = xlCalculationManual
  For k = 2 To Cells(Rows.Count, 1).End(3).Row
   'If Application.CountIfs(Range("F2:F" & LR), Cells(k, 1), Range("G2:G" & LR), Cells(k, 2)) Then
   'If k >= 20000 Then t2 = Timer(): [E11] = t2 - t1 & " " & k: Application.Calculation = xlCalculationAutomatic: Exit Sub
    x = Application.CountIfs([A:A], Cells(k, 1), [B:B], Cells(k, 2))
    With Sheets("Concat")
     .Columns(3).ColumnWidth = c + d
     .Cells(Rows.Count, 3).End(3).Offset(1, -2) = Cells(k, 1)
     .Cells(Rows.Count, 3).End(3).Offset(1, -1) = DateValue(Format(Cells(k, 2), "0000\/00\/00"))
     .Columns("A:B").VerticalAlignment = xlCenter
     .Columns(2).AutoFit
      With .Cells(Rows.Count, 3).End(3)(2)
       For v = k To k + x - 1
        .Value = .Value & (Trim(Cells(v, 3) & " " & Cells(v, 4).Formula)) & Chr(10)
       Next v
      End With
    End With
   'End If
   k = k + x - 1
  Next k
  Application.Calculation = xlCalculationAutomatic
  t2 = Timer(): [E11] = Format(t2 - t1, "#") & " seg / " & k -2 & " registros (V2)"
End Sub

 

V3

Sub ConcatDadosV3()
 Dim k As Long, x As Long, v As Long, LR As Long, c As Long, d As Long, da As Variant, R As String
 Dim t1 As Date, t2 As Date
 t1 = Timer()
  LR = Cells(Rows.Count, 6).End(3).Row
  c = Columns(3).ColumnWidth: d = Columns(4).ColumnWidth * 1.4
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  With Sheets("Concat")
   .Columns(3).ColumnWidth = c + d
   .Columns("A:B").VerticalAlignment = xlCenter
   For k = 2 To Cells(Rows.Count, 1).End(3).Row
    'If Application.CountIfs(Range("F2:F" & LR), Cells(k, 1), Range("G2:G" & LR), Cells(k, 2)) Then
     'If k >= 20000 Then t2 = Timer(): [E3] = t2 - t1 & " " & k: Application.Calculation = xlCalculationAutomatic: Exit Sub
     .Cells(Rows.Count, 3).End(3).Offset(1, -2) = Cells(k, 1)
     .Cells(Rows.Count, 3).End(3).Offset(1, -1) = DateValue(Format(Cells(k, 2), "0000\/00\/00"))
     x = Application.CountIfs([A:A], Cells(k, 1), [B:B], Cells(k, 2))
     da = Range(Cells(k, 3), Cells(k + x - 1, 4)).Formula
     For v = 1 To UBound(da)
       R = R & da(v, 1) & " " & da(v, 2) & Chr(10)
     Next
     .Cells(Rows.Count, 3).End(3)(2) = R: R = ""
    k = k + x - 1
    'End If
   Next k
   .Columns(2).AutoFit
  End With
  Application.Calculation = xlCalculationAutomatic
  t2 = Timer(): [E3] = Format(t2 - t1, "#") & " seg / " & k-2  & " registros (V3)"
End Sub

 

Link para o comentário
Compartilhar em outros sites

Olá Osvaldomp, tudo bem?

 

Desculpe a demora em retornar. Então, deu um trabalho separar e limpar as planilhas com os dados, mas depois disso os 3 códigos rodaram muito bem.

Para um pouco mais de 1 milhão de linhas, não percebi diferença grande de tempo entre eles, a tela ficou branca e com mensagem de não respondendo mas depois liberou. 

Eu peguei os códigos e rodei um em cada planilha com informações diferentes e o maravilhoso resultado apareceu em todas.

Sua macro foi de uma ajuda imensa! Como eu disse anteriormente, espero ter a possibilidade de te ajudar no futuro.

 

Obrigada

Link para o comentário
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisa ser um usuário para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...