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
 
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
 

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


'====================================================================
'https://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
 

@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
 

@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
 

@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
 

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
 

@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

×