Ir ao conteúdo
  • Comunicados

    • Gabriel Torres

      Seja um moderador do Clube do Hardware!   12-02-2016

      Prezados membros do Clube do Hardware, Está aberto o processo de seleção de novos moderadores para diversos setores ou áreas do Clube do Hardware. Os requisitos são:   Pelo menos 500 posts e um ano de cadastro; Boa frequência de participação; Ser respeitoso, cordial e educado com os demais membros; Ter bom nível de português; Ter razoável conhecimento da área em que pretende atuar; Saber trabalhar em equipe (com os moderadores, coordenadores e administradores).   Os interessados deverão enviar uma mensagem privada para o usuário @Equipe Clube do Hardware com o título "Candidato a moderador". A mensagem deverá conter respostas às perguntas abaixo:   Qual o seu nome completo? Qual sua data de nascimento? Qual sua formação/profissão? Já atuou como moderador em algo outro fórum, se sim, qual? De forma sucinta, explique o porquê de querer ser moderador do fórum e conte-nos um pouco sobre você.   OBS: Não se trata de função remunerada. Todos que fazem parte do staff são voluntários.
mdiego

Extrair valores únicos através de macro e comparar

Recommended Posts

Boa noite, 

 

É  possível eu extrair dados de uma coluna que tenho vários valores repetidos? Fiz através de fórmula matricial, mas a planilha ficou lenta e pesada até para abrir pelo fato de eu ter mais de 5000 linhas. 

 

E depois de extrair os dados comparar valores unicos com plano e verificar qual está fora.  

 

Por exemplo:   Coluna A            Valores Unicos    Plano            Fora            

                        88207000           88207000           88207000     88207010

                        88207000           88207002           88207002

                        88207010           88207010

                        88207000

                        88207000

                        88207002

                        88207000

 

Não sei mais o que fazer.

Compartilhar este post


Link para o post
Compartilhar em outros sites

Boa noite,

 

Veja se este código resolve seu caso:

 

Sub ExtrairUnicosComparar
Dim mCamposFiltro(0) As New com.sun.star.sheet.TableFilterField
   
   oPlan = ThisComponent.Sheets.getByName( "Planilha1" )
   oIntervalo = oPlan.getCellRangeByName( "A2:A5000" )
   
   'Descritor do filtro
   oDescFiltro = oIntervalo.createFilterDescriptor( True )
   
   'Definir os campos
   mCamposFiltro(0).Field = 0
   mCamposFiltro(0).Operator = 1
   
   'Estabelecer o destino
   oDestino = oPlan.getCellRangeByName( "B2" ).getCellAddress()
   'Propriedades do filtro padrão
   oDescFiltro.ContainsHeader = False
   oDescFiltro.SkipDuplicates = True
   oDescFiltro.CopyOutputData = True
   oDescFiltro.OutputPosition = oDestino
   oDescFiltro.FilterFields = mCamposFiltro
   
   oIntervalo.Filter( oDescFiltro )
   
   Lin  = 0
   Do
     Lin = Lin+1
     oCel = oPlan.getCellByPosition( 1,Lin )
   Loop Until  oCel.String = ""
   mValoresUnicos = oPlan.getCellRangeByName("B2:B"&Lin).getDataArray

   Lin  = 0
   Do
     Lin = Lin+1
     oCel = oPlan.getCellByPosition( 2,Lin )
   Loop Until  oCel.String = ""   
   mPlano = oPlan.getCellRangeByName("C2:C"&Lin).getDataArray
   
   L = 1
   For I = 0 To Ubound(mValoresUnicos)
      bIgual = False
      For J = 0 To Ubound(mPlano)
         If mPlano(J)(0) = mValoresUnicos(I)(0) Then
      	    bIgual = True
            Exit For
         End If
       Next
      
      If Not bIgual Then
         oPlan.getCellByPosition( 3,L ).Value = mValoresUnicos(I)(0)
         L = L + 1
      End If
   Next	
	
End Sub

 

[]s.

  • Curtir 1

Compartilhar este post


Link para o post
Compartilhar em outros sites
  • Autor do tópico
  • 14 horas atrás, TianK disse:

    Boa noite,

     

    Veja se este código resolve seu caso:

     

    
    Sub ExtrairUnicosComparar
    Dim mCamposFiltro(0) As New com.sun.star.sheet.TableFilterField
       
       oPlan = ThisComponent.Sheets.getByName( "Planilha1" )
       oIntervalo = oPlan.getCellRangeByName( "A2:A5000" )
       
       'Descritor do filtro
       oDescFiltro = oIntervalo.createFilterDescriptor( True )
       
       'Definir os campos
       mCamposFiltro(0).Field = 0
       mCamposFiltro(0).Operator = 1
       
       'Estabelecer o destino
       oDestino = oPlan.getCellRangeByName( "B2" ).getCellAddress()
       'Propriedades do filtro padrão
       oDescFiltro.ContainsHeader = False
       oDescFiltro.SkipDuplicates = True
       oDescFiltro.CopyOutputData = True
       oDescFiltro.OutputPosition = oDestino
       oDescFiltro.FilterFields = mCamposFiltro
       
       oIntervalo.Filter( oDescFiltro )
       
       Lin  = 0
       Do
         Lin = Lin+1
         oCel = oPlan.getCellByPosition( 1,Lin )
       Loop Until  oCel.String = ""
       mValoresUnicos = oPlan.getCellRangeByName("B2:B"&Lin).getDataArray
    
       Lin  = 0
       Do
         Lin = Lin+1
         oCel = oPlan.getCellByPosition( 2,Lin )
       Loop Until  oCel.String = ""   
       mPlano = oPlan.getCellRangeByName("C2:C"&Lin).getDataArray
       
       L = 1
       For I = 0 To Ubound(mValoresUnicos)
          bIgual = False
          For J = 0 To Ubound(mPlano)
             If mPlano(J)(0) = mValoresUnicos(I)(0) Then
          	    bIgual = True
                Exit For
             End If
           Next
          
          If Not bIgual Then
             oPlan.getCellByPosition( 3,L ).Value = mValoresUnicos(I)(0)
             L = L + 1
          End If
       Next	
    	
    End Sub

     

    []s.

     

    adicionado 9 minutos depois

    Boa tarde, 

     

    Tiak, funcionou perfeitamente(só precisa fazer alguns ajustes) estou tentando para aprender! 

    Você é o cara... Você dá aula em algum Lugar? Você é f## 

    Se der aula me passa seu email se possível. 

     

    Não precisa fazer, mas vou te fazer uma pergunta: É possível eu fazer um procv e um somase sem fórmula? Exemplo: 

     

    Tabela a     qtd .       tabela horas padrão

    88207010  300.   .  .       882070010   20

    88207010. 300

     É uma matriz com mais de 5mil linhas

    Relatório

    88207010 qtd 600. H.padrão 20

     

    Faço por fórmula mas trava toda hora e demora pra abrir.

     Muito obrigado e boa semana. 

     

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites

    @mdiego ,

     

    Obrigado mais uma vez pelos comentários generosos. Mas não trabalho com aulas, sou apenas um interessado em ajudar a comunidade com alguma coisa que aprendi de LibreOffice e LO Basic, enquanto aprimoro meus conhecimentos ainda mais. :thumbsup:

     

    2 horas atrás, mdiego disse:

     

    adicionado 9 minutos depois

    [...]

    Não precisa fazer, mas vou te fazer uma pergunta: É possível eu fazer um procv e um somase sem fórmula?

     

    Olha, é possível sim, de duas formas imagino:

    • "Emular" a função PROCV() e a SOMASE() no próprio código Basic, através de loops, testes lógicos (IF's), etc.
    • Chamar estas funções no código através do serviço FunctionAccess e tratar os resultados.

     

    []s.

    TianK

    • Curtir 1

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites
  • Autor do tópico
  • Tiank,

     

    Bacana... Bom, você já deu o caminho com essa FuncitonAcess, vou ver pesquisar sobre...

     

    Fórmulas pra mim é fácil, agora quero ver programar. rs... Tem indicação de livro ou algo do tipo? Ou por onde eu poderia começar? Tenho ótimas noções de lógicas... Por que fiz mecatrônica... 

     

    Obrigado novamente!

    • Curtir 1

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites

    Oi @TianK adorei,vou usar parte de sua Macro acima somente para ExtrairUnicos, já separei parte da macro, porém, pretendo usa-la somo subrotina de macros maiores, exemplo:

     

    -------------------------------------------------------------------
     

    sub MacroMaior

    '    ExtrairUnicos "PlanilhaFonte","Area","PlanilhaSaida","CelulaInicial"
        ExtrairUnicos "Planilha1","A1:A14","Planilha7","A1"
    end sub


    '====================================================================
    'http://www.clubedohardware.com.br/profile/697345-tiank/ (parcial)
    sub ExtrairUnicos (x as string, y as string, z as string, h as string)
    '====================================================================
    Dim mCamposFiltro(0) As New com.sun.star.sheet.TableFilterField
       oPlan = ThisComponent.Sheets.getByName( x )
       oIntervalo = oPlan.getCellRangeByName( y )
       'Descritor do filtro
       oDescFiltro = oIntervalo.createFilterDescriptor( True )
        'Definir os campos
       mCamposFiltro(0).Field = 0
       mCamposFiltro(0).Operator = 1
       'Estabelecer o destino
       oPlan = ThisComponent.Sheets.getByName( z )
       oDestino = oPlan.getCellRangeByName( h ).getCellAddress()
       'Propriedades do filtro padrão
       oDescFiltro.ContainsHeader = False
       oDescFiltro.SkipDuplicates = True
       oDescFiltro.CopyOutputData = True
       oDescFiltro.OutputPosition = oDestino
       oDescFiltro.FilterFields = mCamposFiltro
       oIntervalo.Filter( oDescFiltro )
    end sub

     

    ------------------------------------

     

    Já esta funcionando, porém é possível, de informar só duas variáveis na chamada ao invés de quatro.

     

    Esta assim:  ExtrairUnicos "Planilha1","A1:A14","Planilha7","A1",

    aqui é informada planilha e célula separados.

     

    Ser assim:  ExtrairUnicos "Planilha1,A1:A14" , "Planilha7,A1"

    aqui informar Planilha e Área(ou Célula) juntas

    Editado por g.schiavinatto
    • Curtir 1

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites
  • Autor do tópico
  • @TianK    Boa noite,

     

    Estou mandando o link com planilha. https://drive.google.com/open?id=0Bz3LYO6GGOAwNVRYMmI2d0dtX1U


    Apanhei pacas, não tô conseguindo...

    Vê se é possível alterar ou fazer alguma coisa disso que eu comentei (Na planilha também há comentário)

     

    Sem sei se é possível, obrigado e desculpe-me por tanta encheção.

     

    Obrigado! 

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites
    Em 24/11/2016 às 17:34, g.schiavinatto disse:

    [...]

     

    Já esta funcionando, porém é possível, de informar só duas variáveis na chamada ao invés de quatro.

     

    Esta assim:  ExtrairUnicos "Planilha1","A1:A14","Planilha7","A1",

    aqui é informada planilha e célula separados.

     

    Ser assim:  ExtrairUnicos "Planilha1,A1:A14" , "Planilha7,A1"

    aqui informar Planilha e Área(ou Célula) juntas

     

    Muito bacana a sua ideia de uso. Gostei bastante!

     

    Minha sugestão, se permite, é fornecer "Planilha1.A1:A14" e "Planilha7.A1" (separados por ponto "."), exatamente da forma como são feitas as referências a planilha e intervalo, planilha e célula no Calc.

     

    A chamada ficaria:

    Sub MacroMaior
       ExtrairUnicos "Planilha1.A1:A14" , "Planilha7.A1
    
     ' ou como gosto de usar:
     ' Call ExtrairUnicos( "Planilha.A1:A14","Planilha7.A1" )
    End Sub

    E as linhas para "tratar" os parâmetros seriam:

    sub ExtrairUnicos (x as string, y as string)
    '====================================================================
    Dim mCamposFiltro(0) As New com.sun.star.sheet.TableFilterField
    
       xi = Split( x,"." )
       yi = Split( y,"." )
    
       oPlan = ThisComponent.Sheets.getByName( xi(0) )
       oIntervalo = oPlan.getCellRangeByName( xi(1) )
       
       '=> esta parte permanece idêntica <=
       
       oPlan = ThisComponent.Sheets.getByName( yi(0) )
       oDestino = oPlan.getCellRangeByName( yi(1) ).getCellAddress()
    
       '=> Restante permanece igual <=

     

    []s.

    TianK

    adicionado 12 minutos depois

    @mdiego Boa noite,

     

    Ainda não tive tempo para olhar sua planilha com calma. Mas estive pensando que talvez ajudasse, no seu caso, desativar a opção "Autocalcular". Ela faz com que o Calc processe todas as fórmulas todas as vezes que se altera uma célula na planilha. Então, desativada, os cálculos só acontecerão quando você abrir o arquivo ou pressionar F9 (recalcular) e Ctrl + F9 (recalcular todas as fórmulas).

     

    Na minha versão do LO Calc, ela fica em Dados -> Calcular -> Autocalcular.

     

    Em versões anteriores: Ferramentas  -> Conteúdos da Célula -> Autocalcular.

     

     

    []s.

    TianK

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites
  • Autor do tópico
  • @TianK Ok, Tiank!  Muito obrigado pela ajuda. 

    Como sempre bem solicito! 

    Você é o cara.

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites

    Bom dia,

     

    Abaixo está uma subrotina que preenche as colunas B:C e H:I com os resultados das suas fórmulas, chamando as funções internas do Calc, através do serviço FunctionAccess. Estas funções devem ser invocadas pelo seu nome em inglês: SUMIF (SOMASE), VLOOKUP (PROCV) e os argumentos, passados como uma matriz (função Array()).

     

    Sub ProcurarSomar()
    
       oPlanBaseHoras = ThisComponent.Sheets.getByName( "BASE HORAS" )
       oPlanBaseLogix = ThisComponent.Sheets.getByName( "BaseLogix" )
       oPlanBase = ThisComponent.Sheets.getByName( "Base" )
       
       Lin1  = 0
       Do
         Lin1 = Lin1+1
         oCel = oPlanBase.getCellByPosition( 0,Lin1 )
       Loop Until  oCel.String = ""
       
       Lin2 = 0
       Do
         Lin2 = Lin2+1
         oCel = oPlanBase.getCellByPosition( 6,Lin2 )
       Loop Until  oCel.String = ""
       
       If Lin1 > Lin2 Then
         Lin = Lin1
       Else
         Lin = Lin2
       End If
          
       oFnA = createUnoService("com.sun.star.sheet.FunctionAccess")
     
       oIntervalo = oPlanBaseLogix.getCellRangeByName( "A2:A5001" )
       oSomaIntervalo = oPlanBaseLogix.getCellRangeByName( "G2:G5001" )
       oIntervaloHoras = oPlanBaseHoras.getCellRangeByName( "A1:B7" )
    	
       For I = 1 To (Lin-1)
          ' Colunas B e C
          sCriterio = oPlanBase.getCellByPosition( 0,I ).String
          vTotal = oFnA.callFunction( "SUMIF", Array(oIntervalo, sCriterio, oSomaIntervalo) )
          oPlanBase.getCellByPosition( 1,I ).Value = vTotal
          vHoras = oFnA.callFunction( "VLOOKUP", Array(sCriterio,oIntervaloHoras,2,False) )
          oPlanBase.getCellByPosition( 2,I ).Value = vHoras * vTotal
          ' Colunas H e I
          sCriterio2 = oPlanBase.getCellByPosition( 6,I ).String
          vTotal = oFnA.callFunction( "SUMIF", Array(oIntervalo, sCriterio2, oSomaIntervalo) )
          oPlanBase.getCellByPosition( 7,I ).Value = vTotal
          vHoras = oFnA.callFunction( "VLOOKUP", Array(sCriterio2,oIntervaloHoras,2,False) )
          oPlanBase.getCellByPosition( 8,I ).Value = vHoras * vTotal
       Next
       
    End Sub

     

    E quanto aos demais comentários no arquivo, estou juntando um .ods com o código adaptado para atender (ou pelo menos tentar) o pedido. :thumbsup:

     

     

    []s.

    TianK

     

    mdiego1130.ods.zip

    • Curtir 1

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites
  • Autor do tópico
  • @TianK Obrigado Tiank! 

     

    Deveria escrever um livro. rs

     

    Vou analisar esses códigos e refazer para aprender. Aquela macro de importar os dados me facilitou a vida, demorava 2 dias para importar tudo agora faço em 1 hora no máx.

     

    Obrigado novamente! Mito.

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites
  • Autor do tópico
  • Estou com um probleminha - Quando compara o campo dos códigos unicos x plano ->>>> Ele não consegue comparar um valor sem string.

                                               Por exemplo:    Valores Unicos            Plano            FORA DO PLANO

                                                                           88207010F        88207010F          88207006

                                                                            88597006           88597006

    Ele está me dizendo que todos sem letra está fora do plano. Sabe me dizer o por que?  E estou tentando desvendar bruxaria que foi feita pra preencher as datas únicas. (Se poder me indicar em qual parte do código está isso)

     

    Desculpa pelos transtornos Tiank. 

     

    Obrigado!

    Editado por mdiego

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites

    @mdiego Boa tarde,

     

    Meu palpite é que, p. ex., "88597006" está numa coluna como número e na outra como string. Então para funcionar, é preciso alterar a linha na macro "ExtrairCompararProcSomar":

    If mPlano(J)(0) = mValoresUnicos(I)(0) Then

    por

    If CStr(mPlano(J)(0)) = CStr(mValoresUnicos(I)(0)) Then

    A função CStr() dos dois lados da igualdade "forçará" a comparação acontecer como string.

     

     

    Bem, para preencher as datas únicas veja este trecho:

    ' Extrair os valores únicos
       Call ExtrairUnicos( "BaseLogix.A2:A5000","Base.A2" )
       Call ExtrairUnicos( "BaseLogix.H2:H5000","Base.L2" )

    A segunda chamada (Call) da subrotina "ExtrairUnicos" aponta para a coluna H, onde estão as datas, e para L2, onde (a partir de) serão colocadas as datas únicas. Aqui tomei a liberdade de pegar a ideia de @g.schiavinatto para uma subrotina. O que é muito versátil e permite reutilizar o código com pouquíssimo trabalho.

     

    Espero ter esclarecido! :thumbsup:

     

    []s.

    Tiank

     

    • Curtir 1

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites
  • Autor do tópico
  • @TianK  Deu certinho! 

    Caramba, você tem um baita conhecimento sobre esse LO. Me indica algum Livro ou Fórum Tiank?  Fórmulas eu conheço bem, eu tentei adaptar algumas coisas na sua e só  deu erro. 

    Um grande abraço, facilitou muitas coisas...  

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites

    @TianK sobre a "Sub MacroMaior" funcionou perfeitamente.

     

    E sobre seu comentário "Muito bacana a sua ideia de uso. Gostei bastante!", estou montando um arquivo com Sub-Macros (até agora +/- 40), estou montando com as básicas de uso ( selecionar, copiar, colar etc ) e algumas especiais, como esta sua, estou organizando o arquivo, assim que ficar utilizável te passarei para sua avaliação e comentário.

     

    Só um exemplo: Uma Macro que seleciona uma área, copia e cola em outro lugar, seria montada assim:


     

    sub Macro
    ' selecionar a área para copiar
    Selecionar "Planilha1.A1:C25"
    ' copiar a área selecionada
    Copiar
    ' Ir para o local de colagem
    Selecionar "Planilha5.A7"
    ' colar
    Colar
    end sub

    Assim a chamada é simples, como escrever uma "Receita de Bolo". hahahahaha.

     

    Editado por g.schiavinatto

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites
    Em 04/12/2016 às 20:01, g.schiavinatto disse:

    @TianK sobre a "Sub MacroMaior" funcionou perfeitamente.

     

    E sobre seu comentário "Muito bacana a sua ideia de uso. Gostei bastante!", estou montando um arquivo com Sub-Macros (até agora +/- 40), estou montando com as básicas de uso ( selecionar, copiar, colar etc ) e algumas especiais, como esta sua, estou organizando o arquivo, assim que ficar utilizável te passarei para sua avaliação e comentário.

     

    Só um exemplo: Uma Macro que seleciona uma área, copia e cola em outro lugar, seria montada assim:


     

    
    sub Macro
    ' selecionar a área para copiar
    Selecionar "Planilha1.A1:C25"
    ' copiar a área selecionada
    Copiar
    ' Ir para o local de colagem
    Selecionar "Planilha5.A7"
    ' colar
    Colar
    end sub

    Assim a chamada é simples, como escrever uma "Receita de Bolo". hahahahaha.

     

    Ola @Tiank, o estudo acima estava parado, dei mais um empurrão e estou passando para ti dar uma olhada e comentar.

    TianK_amostra.zip

    • Curtir 1

    Compartilhar este post


    Link para o post
    Compartilhar em outros sites

    Crie uma conta ou entre para comentar

    Você precisar ser um membro para fazer um comentário






    Sobre o Clube do Hardware

    No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas publicações 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

    ×