Macro para filtrar Valores

tjarodri · September 20, 2013, 6:46pm

Caros,
Estou desenvolvendo um projeto e preciso criar uma rotina de edição de dados. Neste caso a macro deve filtrar na base o número selecionado e colar na linha filtrada os novos valores. Em MsExcel esta macro roda normalmente porem não estou conseguindo encontrar uma forma de rodar em LibreOffice.

Obs: O filtro acontece de acordo com o valor que esta na range “W1”

Segue o código em MSEVBA

Application.DisplayAlerts = False
Application.ScreenUpdating = False

If Worksheets(“Home”).Range(“I29”).Value = “” Then
MsgBox “Obrigatório escolher Status do Atendimento”, vbCritical, “Formulário Ativo - Amil”

Else
If Worksheets(“Home”).Range(“I29”).Value > 0 Then

'Filtra a M.O Para colar.
Sheets("BASE PF").Select
Selection.End(xlUp).Select
Selection.End(xlToLeft).Select
Selection.End(xlUp).Select
Selection.End(xlUp).Select
Selection.End(xlToLeft).Select
ActiveSheet.Range("$A$1:$U$1045").AutoFilter Field:=2, Criteria1:=Range("=W1"), _
    Operator:=xlAnd
 
'Copiar dados para colar na base.
Sheets("Home").Select
ActiveSheet.Unprotect Password:=5609
Range("V45:AD45").Select
Selection.Copy
Sheets("BASE PF").Select
Range("N1").Select
Selection.End(xlDown).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.ShowAllData

ActiveSheet.Range("$A$1:$U$1045").AutoFilter Field:=14, Criteria1:= _
    "Contato Realizado"
    Range("$A$2:$V$1045").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("BaseII").Select
Range("A1").Select
Selection.End(xlDown).Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Sheets("BASE PF").Select
Application.CutCopyMode = False
Selection.EntireRow.Delete
Selection.End(xlUp).Select
ActiveSheet.ShowAllData
'Limpar linhas Preenchidas da Cadastro.

Sheets("Home").Select

Worksheets(“Home”).Range(“I29”).Value = “”
Worksheets(“Home”).Range(“I31”).Value = “”
Worksheets(“Home”).Range(“M31”).Value = “”
Worksheets(“Home”).Range(“N36”).Value = “”
Worksheets(“Home”).Range(“N38”).Value = “”
Worksheets(“Home”).Range(“M29”).Value = “”
Worksheets(“Home”).Range(“N34”).Value = “”

'Escolher novo MO.

 Range("V15").Select
ActiveCell.FormulaR1C1 = "=RANDBETWEEN('BASE PF'!R2C1,'BASE PF'!R968C1)"
Range("V15").Select
Selection.Copy
Range("V12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False

'Protege a planilha.
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=5609
Range(“I29”).Select
MsgBox “Dados cadastrado com Sucesso.”, vbInformation, “Formulário Ativo - Amil”

End If
End If
End Sub

Grafeno · September 20, 2013, 8:49pm

Dê uma olhada na resposta do Olivier aqui: [ Why is the recent documents list empty in 3.5? - #2 by thed ]

esp · September 23, 2015, 8:10pm

Sem querer te desanimar, mas isso ai em basic… alias, qualquer coisa em basic é complicado. no VBA até aprendemos de forma autodidata, mas no basic… faça um teste, grave a macro copiando uma célular e colando em outra, depois olhe o código que foi gerado.
Mas por exeperiência sei que alguns macros do excel rodam no calc, mas… saber o que roda e o que não roda e porque…

JúnioVieira · October 20, 2017, 10:40am

Olá tjarodri, pelo que eu entendi você tem um banco de dados e quer filtrar no próprio banco e depois copiar os dados filtrados e colar em outro local. É isso?

kaduleite · May 14, 2020, 12:37pm

Não ficou claro o que quer fazer.

WBastos · April 29, 2021, 10:33pm

@tjarodri, veja se é o que você procura.
Fiz um filtro avançado que utiliza vários critérios. Posteriormente estarei elaborando uma Caixa de Diálogo para inserção dos parâmetros de pesquisa.

Option Explicit 
Private oPlan1 as Object
Private oPlan2 as Object
Private oIntervalo As Object
Private oCriterios As Object
Private oDestino As Object
Private oFiltro As Object

REM --------------------------------------------------------------------------------------
Sub FiltroAvancado
   oPlan1 = ThisComponent.Sheets.getByName( "BaseDados" )
   oPlan2 = ThisComponent.Sheets.getByName( "Filtro" )
   
   oIntervalo = oPlan1.getCellRangeByName( "A1:G1000000" )
   oCriterios = oPlan2.getCellRangeByName( "Criterios" )
   oDestino = oPlan2.getCellRangeByName( "Destino" )
 
   oFiltro = oCriterios.createFilterDescriptorByObject( oIntervalo )
   oFiltro.CopyOutputData = TRUE
   oFiltro.OutputPosition = oDestino.CellAddress
   oFiltro.ContainsHeader = False

   oIntervalo.Filter( oFiltro )
     	If oPlan2.getCellRangeByName( "Destino" ).string="" Then
     		Call RemoverFiltros
   			MsgBox "Não há lançamentos nesta data!" & Chr(13) & "Por favor tente novamente", 64, "Atenção"
   		End If
End Sub

REM --------------------------------------------------------------------------------------
Sub RemoverFiltros
   oPlan1 = ThisComponent.Sheets.getByName( "Filtro" )
   oCriterios = oPlan1.getCellRangeByName( "DadosFiltrados" )
   oCriterios.ClearContents (1 OR 2 OR 4 OR 8 OR 16 OR 32 OR 64 OR 128 OR 256 OR 512)
End Sub

Link do arquivo: Planilha Modelo