Extrair valores únicos através de macro e comparar

mdiego · 21 de novembro de 2016

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

88207002

88207000

Não sei mais o que fazer.

TianK · 23 de novembro de 2016

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.

mdiego · 24 de novembro de 2016

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.

TianK · 24 de novembro de 2016

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

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

mdiego · 24 de novembro de 2016

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!

Schiavinatto · 24 de novembro de 2016

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

mdiego · 24 de novembro de 2016

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

TianK · 26 de novembro de 2016

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

mdiego · 27 de novembro de 2016

@TianK Ok, Tiank! Muito obrigado pela ajuda.

Como sempre bem solicito!

Você é o cara.

TianK · 30 de novembro de 2016

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.

[]s.

TianK

mdiego1130.ods.zip

mdiego · 30 de novembro de 2016

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

mdiego · 30 de novembro de 2016

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!

TianK · 1 de dezembro de 2016

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

[]s.

Tiank

mdiego · 1 de dezembro de 2016

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

Schiavinatto · 4 de dezembro de 2016

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

Schiavinatto · 1 de dezembro de 2017

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.