Ir ao conteúdo
Regras do Clube do Hardware

Excel Extrair mais de um dado de uma célula

Yskhadar

Por Yskhadar
em Microsoft Office e similares

 Compartilhar
Ir à solução Resolvido por Midori,

Posts recomendados

Yskhadar
 

Yskhadar

Postado
Postado

Boa noite,

 

Estou precisando de uma ajuda .

Tenho uma planilha com diversas linhas com dados de zonas eleitorais.

Preciso extrair de um texto algumas informações mas elas tem tamanhos diferentes.

Ex:

Bairro : LINHA PEDRA BRANCA Seções: 1 Eleitores: 212 Seções Previstas: 1

Preciso extrair o Bairro, Seções, Eleitores e Seções Previstas

Anexo uma planilha do resultado esperado.

Desde já agradeço.

 

Abs

 

Extracao.xlsx

Visitante
 

Visitante

Postado
Postado

 

experimente:

 

bairro 

=ext.texto(a2;10;procurar("seções";a2)-11)

 

seções 

=ext.texto(a2;procurar("seções";a2)+8;1)

 

eleitores 

=ext.texto(a2;procurar("seções";a2)+21;procurar(" ";a2;procurar("seções";a2)+21)-procurar("seções";a2)-21)

 

seções previstas 

=direita(a2;1)

 

 

  • 2 semanas depois...
Yskhadar
 

Yskhadar

Postado
  • Autor
Postado

Bom dia!

 

Continuando a saga desta planilha, após a ajuda do Osvaldo, que resolveu meu problema, agora arrumei outro problema.

Depois da extração dos dados pelas colunas, agora preciso transformar em linhas...

Anexo está a planilha e a explicação está nela.

Agradeço demais.

 

Ps: Lembrando, o arquivo original tem umas 29mil linhas...

 

Extracao2.xlsx

Visitante
 

Visitante

Postado
Postado

 

"E que as informações da respectova zona sejam preenchidas em todas as linhas."

 

Qual a origem dos dados que estão nas colunas F:H da planilha Listagem ?

image.png

Visitante
 

Visitante

Postado
Postado
12 minutos atrás, Yskhadar disse:

 

Os dados das colunas A até H são repetidos na plan Listagem, ...

 

 

Mas não batem, veja abaixo. 🤪

 

TRE PR (2)

image.png.744b43bba847666bbb6fbd67a5c71fe5.png

 

 

Listagem

image.png.b97ff0d82565ae14c691aff9488567eb.png

Yskhadar
 

Yskhadar

Postado
  • Autor
Postado

@Midori essa seria a ideia, mas não sei fazer, por isso peço ajuda.

@osvaldomp a planilha listagem estará vazia.. o que fiz foi colocar os dados lá para servirem de amostra como o resultado esperado, devo ter pego algum dado divergente. Eu só tenho a plan TRE. A listagem deverá ser criada...

 

Midori
 

Midori

Postado
Postado

@Yskhadar  A macro pega da linha 2 até a 13, quando houver mais é só editar o range ou implementar uma variável para verificar a última linha como fiz na variável LinhaListagem.

  

Sub Macro()
    Dim Celula          As Range
    Dim Area1, Area2    As Range
    Dim LinhaListagem   As Long
    
    For Each Celula In ThisWorkbook.Worksheets("TRE PR (2)").Range("A2:A13")
        Set Area1 = Celula.Resize(1, Celula.Offset(0, 10).End(xlToRight).Column).Resize(1, 8)
        Set Area2 = Celula.Offset(0, 9).Resize(1, Celula.Offset(0, 9).End(xlToRight).Column - 9)
        
        With ThisWorkbook.Worksheets("Listagem")
            LinhaListagem = Range("A1000000").End(xlUp).Row + 1
            Area1.Copy
            .Cells(LinhaListagem, 1).Resize(Area2.Columns.Count, 1).PasteSpecial
            Area2.Copy
            .Cells(LinhaListagem, 9).PasteSpecial Transpose:=True
        End With
    Next Celula
End Sub

 

Yskhadar
 

Yskhadar

Postado
  • Autor
Postado

@Midori

 

Como saberei se vai passar de 1M (1 milhao?)

Devo por quanto?

E 30.000 linhas é o arquivo original, o arquivo ajustado são só 4892 linhas...

adicionado 9 minutos depois

E muito estranho... rodou mas apagou todo o começo e ficou só o final...

Aí os dados ficaram da linha 4893 até 21267 e com dados repetidos...

A única alteração que fiz foi trocar o a13 por a4892 que ó final da planilha.

Fiz algo errado?

Midori
 

Midori

Postado
Postado
37 minutos atrás, Yskhadar disse:

E muito estranho... rodou mas apagou todo o começo e ficou só o final...

Aí os dados ficaram da linha 4893 até 21267 e com dados repetidos...

A única alteração que fiz foi trocar o a13 por a4892 que ó final da planilha.

Fiz algo errado?

Se a planilha TRE for até linha 4892, é só substituir A13 por A4892.

 

Depois de rodar a planilha Listagem ficou com quantas linhas?

Yskhadar
 

Yskhadar

Postado
  • Autor
Postado

Os dados ficaram da linha 4893 até 21267 e com dados repetidos no final...

A única alteração que fiz foi trocar o a13 por a4892 que é final da planilha. Agora você confirmou isso.

Rodando na planilha que postei aqui, dá certinho.

Rodando na original, dá esse rolo aí de cima.

Mas as planilhas são exatamente iguais, só muda a quantidade de linhas. Eu tirei uma parte dela para fazer esta de exemplo.

Pelas contas das seções deveria ficar com 27.425

Midori
 

Midori

Postado
Postado

@Yskhadar Alterei o código para interromper quando chegar no limite de linhas e já ajustei o range. Veja o que acontece.

  

Sub Macro()
    Dim Celula          As Range
    Dim Area1, Area2    As Range
    Dim LinhaListagem   As Long
    
    On Error GoTo FIM
    
    For Each Celula In ThisWorkbook.Worksheets("TRE PR (2)").Range("A2:A4892")
        Set Area1 = Celula.Resize(1, Celula.Offset(0, 10).End(xlToRight).Column).Resize(1, 8)
        Set Area2 = Celula.Offset(0, 9).Resize(1, Celula.Offset(0, 9).End(xlToRight).Column - 9)
        
        With ThisWorkbook.Worksheets("Listagem")
            LinhaListagem = Range("A1048576").End(xlUp).Row + 1
            
            If .Cells(LinhaListagem, 1) <> "" Then
                MsgBox "Erro 1"
                Exit Sub
            End If
            
            Area1.Copy
            .Cells(LinhaListagem, 1).Resize(Area2.Columns.Count, 1).PasteSpecial
            Area2.Copy
            .Cells(LinhaListagem, 9).PasteSpecial Transpose:=True
        End With
    Next Celula

FIM: If Err.Number = 1004 Then MsgBox "Erro 2"

End Sub

 

Yskhadar
 

Yskhadar

Postado
  • Autor
Postado

Copiou apenas até a sessão 12 e foi até a linha 1034517. Deve ter repetido um montão de dados..

E termina no msgbox erro 2

Nao está funcionando...

 

Midori
 

Midori

Postado
Postado

@Yskhadar Retornou esse erro porque está chegando no limite de linhas...

 

E o código não copia linha repetida.

 

Se tem dado repetido é porque você rodou mais de uma vez antes de limpar a planilha Listagem. Ou seja, antes de rodar a macro a planilha Listagem deve conter apenas a primeira linha com os nomes das colunas.

 

E se mesmo após tudo isso acontecer o Erro 2, será preciso rever se é o caso de usar Excel mesmo (criando outras abas quando isso acontecer) ou tentar com outro aplicativo tipo Access ou um TXT....

Yskhadar
 

Yskhadar

Postado
  • Autor
Postado

Eu limpei a planilha listagem e rodei a macro apenas uma vez.

Até a sessão 4, linha 1604 foi bem, depois repetiu os mesmo dados até a linha 17978.

Aí pula uma parte e repete de novo.

Sou leigo nisso. Só faço macros gravadas pelo excel e as vezes alguns ajustes e só.

Deixa eu entender uma coisa: na macro, área 1 ele pega os dados da coluna 10 (J) e está deslocando 8 colunas é isso?

Porque tem algumas sessões que tem 40 colunas, outras 4, são tamanhos variáveis. Isso influencia o restante do código?

Midori
 

Midori

Postado
Postado

@Yskhadar Agora vi que tinha alguns problemas no código, fiz uma correção e coloquei um If para tratar o caso onde tenha apenas uma seção. Isso deixava a macro bugada no Area2.

  

Sub Macro()
    Dim Celula          As Range
    Dim Area1, Area2    As Range
    Dim LinhaListagem   As Long
    
    On Error GoTo FIM
    
    For Each Celula In ThisWorkbook.Worksheets("TRE PR (2)").Range("A2:A4892")
        Set Area1 = Celula.Resize(1, Celula.Offset(0, 10).End(xlToRight).Column).Resize(1, 8)
        Set Area2 = Celula.Offset(0, 9).Resize(1, Celula.Offset(0, 9).End(xlToRight).Column - 9)
            
        If Area2.Cells(1, 1).Offset(0, 1) = "" Then
            Set Area2 = Area2.Cells(1, 1)
        End If
        
        With ThisWorkbook.Worksheets("Listagem")
            LinhaListagem = .Range("A1048576").End(xlUp).Row + 1
            If .Cells(LinhaListagem, 1) <> "" Then
                MsgBox "Erro 1"
                Exit Sub
            End If
            
            Area1.Copy
            .Cells(LinhaListagem, 1).Resize(Area2.Columns.Count, 1).PasteSpecial
            Area2.Copy
            .Cells(LinhaListagem, 9).PasteSpecial Transpose:=True
        End With
    Next Celula

FIM: If Err.Number = 1004 Then MsgBox "Erro 2"

End Sub

 

37 minutos atrás, Yskhadar disse:

Deixa eu entender uma coisa: na macro, área 1 ele pega os dados da coluna 10 (J) e está deslocando 8 colunas é isso?

Porque tem algumas sessões que tem 40 colunas, outras 4, são tamanhos variáveis. Isso influencia o restante do código?

 

Area1 pega as linhas da primeira tabela, por exemplo A2:H2, A3:H3, etc.

 

Area2, onde eu acho que está dando problema, pega as linhas das colunas que variam. Por exemplo na planilha que você postou pega J2:T2, J3:O3, J4:AW4, etc. Para colar/transpor na outra planilha.

 

Yskhadar
 

Yskhadar

Postado
  • Autor
Postado

Entendi.

Fui fazendo o depurador até encontrar o erro.

Ele está quando ele localiza na coluna J, que é onde começam as seções, apenas uma seção.

Ele copia a mesma informação por 16374 linhas até ir para a próxima linha. E essa linha copiada tantas vezes a macro não pega a coluna J, fica em branco.

Aí retoma tudo certo até encontrar outra linha com apenas uma seção. E tudo se repete.

Faça o teste replicando várias linhas e deixe algumas com apenas uma sessão pra ver se ocorre o mesmo erro.

Por favor...

 

  • Solução
Midori
 

Midori

Postado
  • Solução
Postado

@Yskhadar Fiz outro código mais simples e com o tratamento do caso de 1 seção,

  

Sub Macro()
    Dim PlanTRE As Worksheet
    Dim A1, A2  As Range
    Dim L, U    As Integer

    On Error GoTo FIM
    
    Set PlanTRE = ThisWorkbook.Worksheets("TRE PR (2)")
    
    For L = 2 To 4892
        Set A1 = PlanTRE.Cells(L, 1).Resize(1, 8)
        Set A2 = PlanTRE.Cells(L, 1).Offset(0, 9)
        
        If A2.Offset(0, 1) <> "" Then
            Set A2 = PlanTRE.Range(A2.Address & ":" & A2.End(xlToRight).Address)
        End If
        
        With ThisWorkbook.Worksheets("Listagem")
            U = .Range("A1048576").End(xlUp).Row + 1
            A1.Copy
            .Cells(U, 1).Resize(A2.Columns.Count, 1).PasteSpecial
            A2.Copy
            .Cells(U, 9).PasteSpecial Transpose:=True
        End With
    Next L

FIM: If Err.Number = 1004 Then MsgBox "Erro"
End Sub

 

  • Curtir 1

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
 Compartilhar
Ir à lista de tópicos

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

Mais

×
×
  • Criar novo...

LANÇAMENTO!

eletronica2025-popup.jpg


CLIQUE AQUI E BAIXE AGORA MESMO!