Ir ao conteúdo
  • Cadastre-se

Outro Copiar a primeira célula acima com inforamção


Posts recomendados

Bom dia pessoal, 

tenho uma planilha aqui na empresa trabalhada a partir de um relatório exportado do sistema.

 

Relatório de conciliação de contas contábeis.

 

Para otimizar meu tempo, trabalho esta planilha de modo a compara-la ao nosso balancete, tudo no libreOffice Calc

 

Meu problema é a disposição dos campos do relatório, por exemplo:

 

image.png.317719d4b5f83abe8397b28c959a834d.png

Vocês podem obervar a primeira linha na coluna B, iniciando com "Conta:....."

Eu preciso trazer o código des conta (11861) para a célula A6 (Vazia abaixo de 30-set-20). Este código será utilizado para comparação do valor no meu balancete, para esta conta específica.

Minha dificuldade é que a planilha é muito extensa, com vários fornecedores, e não há um padrão para o número de linhas para cada fornecedor, devido as particuladades de cada um (número de notas no mês, etc.)

 

Concluindo, preciso de uma forma mais fácil (função ou fórmula) para trazer este código para a célula respectiva a linha do meu saldo final (345,94).

 

Estou enviando em anexo, uma parte da planilha para verificação e exemplo da falta de padrão das informações dos diversos fornecedores.

Sem título 1.xlsx

Link para o comentário
Compartilhar em outros sites

ATENÇÃO........ Macros do Basic se salvar como Excel e descartada, então salve o arquivo como ods

 

Selecione a célula B1 ( tendo como base seu exemplo ), infelizmente executa uma a uma, tentei automatizar, mas esta gerando erro, postei a duvida no https://ask.libreoffice.org/pt-br/question/274048,

com a macro completa ( em B1 terá a formula

=CONT.SE(B2:B1048576;"Conta*")

que identifica quantos Loop a macro deve executar, porém na segunda gera erro.

 

REM  *****  BASIC  *****


sub XPTO
dim document   as object
dim dispatcher as Object
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
rem ----------------------------------------------------------------------
dim args1(20) as new com.sun.star.beans.PropertyValue
args1(0).Name = "SearchItem.StyleFamily"
args1(0).Value = 2
args1(1).Name = "SearchItem.CellType"
args1(1).Value = 0
args1(2).Name = "SearchItem.RowDirection"
args1(2).Value = true
args1(3).Name = "SearchItem.AllTables"
args1(3).Value = false
args1(4).Name = "SearchItem.SearchFiltered"
args1(4).Value = false
args1(5).Name = "SearchItem.Backward"
args1(5).Value = false
args1(6).Name = "SearchItem.Pattern"
args1(6).Value = false
args1(7).Name = "SearchItem.Content"
args1(7).Value = false
args1(8).Name = "SearchItem.AsianOptions"
args1(8).Value = false
args1(9).Name = "SearchItem.AlgorithmType"
args1(9).Value = 0
args1(10).Name = "SearchItem.SearchFlags"
args1(10).Value = 0
args1(11).Name = "SearchItem.SearchString"
args1(11).Value = "Conta"
args1(12).Name = "SearchItem.ReplaceString"
args1(12).Value = ""
args1(13).Name = "SearchItem.Locale"
args1(13).Value = 255
args1(14).Name = "SearchItem.ChangedChars"
args1(14).Value = 2
args1(15).Name = "SearchItem.DeletedChars"
args1(15).Value = 2
args1(16).Name = "SearchItem.InsertedChars"
args1(16).Value = 2
args1(17).Name = "SearchItem.TransliterateFlags"
args1(17).Value = 256
args1(18).Name = "SearchItem.Command"
args1(18).Value = 0
args1(19).Name = "SearchItem.SearchFormatted"
args1(19).Value = false
args1(20).Name = "SearchItem.AlgorithmType2"
args1(20).Value = 1
dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "", 0, args1())
rem ----------------------------------------------------------------------

Execute "Cut"
Execute "GoDown"
Execute "GoDownToEndOfData"
Execute "GoDown"
Execute "Paste"
Execute "GoDown"

end Sub


'-----------------------
'        SubMacros
'-----------------------


Sub GoToCel ( xLocal$ ) 
dim args1(0) as new com.sun.star.beans.PropertyValue : args1(0).Name = "ToPoint" : args1(0).Value = xLocal
CreateUnoService("com.sun.star.frame.DispatchHelper") _
.executeDispatch(ThisComponent.CurrentController.Frame, ".uno:GoToCell", "", 0, args1())
End Sub 


Sub Execute ( o que$ )
CreateUnoService("com.sun.star.frame.DispatchHelper") _
.executeDispatch(ThisComponent.CurrentController.Frame, ".uno:" & o que & "", "", 0, Array())
End Sub

 

Link para o comentário
Compartilhar em outros sites

 

Problema resolvido, segue Macros, lembrando após incluir no arquivo, SALVAR como ods, se for Excel perde as macros.

acione a macro XPTO

 

REM  *****  BASIC  *****


sub XPTO
	GoToCel "B1"
Dim oSel as Object
Dim Var1 As integer 
Dim Var2 As Integer
oSel = ThisComponent.getCurrentSelection()
Var1 = oSel.getString()
	For Var2 = 1 To Var1 Step 1
	Procurar
Execute "Cut"
Execute "GoDown"
Execute "GoDownToEndOfData"
Execute "GoDown"
Execute "Paste"
Execute "GoDown"
	Next
End Sub 


'-----------------------
'        SubMacros
'-----------------------

Sub Procurar
dim args1(20) as new com.sun.star.beans.PropertyValue
args1(0).Name = "SearchItem.StyleFamily"
args1(0).Value = 2
args1(1).Name = "SearchItem.CellType"
args1(1).Value = 0
args1(2).Name = "SearchItem.RowDirection"
args1(2).Value = true
args1(3).Name = "SearchItem.AllTables"
args1(3).Value = false
args1(4).Name = "SearchItem.SearchFiltered"
args1(4).Value = false
args1(5).Name = "SearchItem.Backward"
args1(5).Value = false
args1(6).Name = "SearchItem.Pattern"
args1(6).Value = false
args1(7).Name = "SearchItem.Content"
args1(7).Value = false
args1(8).Name = "SearchItem.AsianOptions"
args1(8).Value = false
args1(9).Name = "SearchItem.AlgorithmType"
args1(9).Value = 0
args1(10).Name = "SearchItem.SearchFlags"
args1(10).Value = 0
args1(11).Name = "SearchItem.SearchString"
args1(11).Value = "Conta"
args1(12).Name = "SearchItem.ReplaceString"
args1(12).Value = ""
args1(13).Name = "SearchItem.Locale"
args1(13).Value = 255
args1(14).Name = "SearchItem.ChangedChars"
args1(14).Value = 2
args1(15).Name = "SearchItem.DeletedChars"
args1(15).Value = 2
args1(16).Name = "SearchItem.InsertedChars"
args1(16).Value = 2
args1(17).Name = "SearchItem.TransliterateFlags"
args1(17).Value = 256
args1(18).Name = "SearchItem.Command"
args1(18).Value = 0
args1(19).Name = "SearchItem.SearchFormatted"
args1(19).Value = false
args1(20).Name = "SearchItem.AlgorithmType2"
args1(20).Value = 1
createUnoService("com.sun.star.frame.DispatchHelper") _
.executeDispatch(ThisComponent.CurrentController.Frame, ".uno:ExecuteSearch", "", 0, args1())
End Sub


Sub GoToCel ( xLocal$ ) 
dim args1(0) as new com.sun.star.beans.PropertyValue : args1(0).Name = "ToPoint" : args1(0).Value = xLocal
CreateUnoService("com.sun.star.frame.DispatchHelper") _
.executeDispatch(ThisComponent.CurrentController.Frame, ".uno:GoToCell", "", 0, args1())
End Sub 


Sub Execute ( o que$ )
CreateUnoService("com.sun.star.frame.DispatchHelper") _
.executeDispatch(ThisComponent.CurrentController.Frame, ".uno:" & o que & "", "", 0, Array())
End Sub

 

E inclua a formula

=CONT.SE(B2:B1048576;"Conta*")

na célula B1

 

E em Ferramentas / Opções / LibreOffice Calc / Calcular

marque Permitir expressões regulares em formulas.

e desmarque Critérios de pesquisa = ou <> devem ser aplicados ao conteúdo integral das células.

OK

 

ATENÇÃO: o arquivo anexo, após baixar altere de .zip para .ods para abri no LibreOffice.

1495883.zip

Link para o comentário
Compartilhar em outros sites

@Schiavinatto, boa tarde.

Corrigi o primeiro problema e fiz a execução da Macro.

Começou bem, mas depois o Libre passou a selecionar as células incorretas para colar a informação do campo copiado (Conta:...). Querendo colar em linhas que já continham informações. 

 

Link para o comentário
Compartilhar em outros sites

Schiavinatto, boa tarde.

Corrigi o primeiro problema e fiz a execução da Macro.

Começou bem, mas depois o Libre passou a selecionar as células incorretas para colar a informação do campo copiado (Conta:...). Querendo colar em linhas que já continham informações. 

 

@Schiavinatto Enviado ne seu e-mail, meu amigo.

Link para o comentário
Compartilhar em outros sites

@Julio M. Abreu  segue macro corrigida:

 

REM  *****  BASIC  *****

sub XPTO
    GoToCel "B1"
Dim oSel as Object
Dim Var1 As integer
Dim Var2 As Integer
Dim Var3 As String
oSel = ThisComponent.getCurrentSelection()
Var1 = oSel.getString()

    For Var2 = 1 To Var1 Step 1
    Procurar
Execute "Cut"
Execute "GoDown"

'====
oSel = ThisComponent.getCurrentSelection()
Var3 = oSel.getString()
    While Var3 <> ""  
Execute "GoDown"
oSel = ThisComponent.getCurrentSelection()
Var3 = oSel.getString()
    Wend
    
Execute "Paste"
Execute "GoDown"
    Next
End Sub


'-----------------------
'        SubMacros
'-----------------------

Sub Procurar
dim args1(20) as new com.sun.star.beans.PropertyValue
args1(0).Name = "SearchItem.StyleFamily"
args1(0).Value = 2
args1(1).Name = "SearchItem.CellType"
args1(1).Value = 0
args1(2).Name = "SearchItem.RowDirection"
args1(2).Value = true
args1(3).Name = "SearchItem.AllTables"
args1(3).Value = false
args1(4).Name = "SearchItem.SearchFiltered"
args1(4).Value = false
args1(5).Name = "SearchItem.Backward"
args1(5).Value = false
args1(6).Name = "SearchItem.Pattern"
args1(6).Value = false
args1(7).Name = "SearchItem.Content"
args1(7).Value = false
args1(8).Name = "SearchItem.AsianOptions"
args1(8).Value = false
args1(9).Name = "SearchItem.AlgorithmType"
args1(9).Value = 0
args1(10).Name = "SearchItem.SearchFlags"
args1(10).Value = 0
args1(11).Name = "SearchItem.SearchString"
args1(11).Value = "Conta"
args1(12).Name = "SearchItem.ReplaceString"
args1(12).Value = ""
args1(13).Name = "SearchItem.Locale"
args1(13).Value = 255
args1(14).Name = "SearchItem.ChangedChars"
args1(14).Value = 2
args1(15).Name = "SearchItem.DeletedChars"
args1(15).Value = 2
args1(16).Name = "SearchItem.InsertedChars"
args1(16).Value = 2
args1(17).Name = "SearchItem.TransliterateFlags"
args1(17).Value = 256
args1(18).Name = "SearchItem.Command"
args1(18).Value = 0
args1(19).Name = "SearchItem.SearchFormatted"
args1(19).Value = false
args1(20).Name = "SearchItem.AlgorithmType2"
args1(20).Value = 1
createUnoService("com.sun.star.frame.DispatchHelper") _
.executeDispatch(ThisComponent.CurrentController.Frame, ".uno:ExecuteSearch", "", 0, args1())
End Sub


Sub GoToCel ( xLocal$ )
dim args1(0) as new com.sun.star.beans.PropertyValue : args1(0).Name = "ToPoint" : args1(0).Value = xLocal
CreateUnoService("com.sun.star.frame.DispatchHelper") _
.executeDispatch(ThisComponent.CurrentController.Frame, ".uno:GoToCell", "", 0, args1())
End Sub


Sub Execute ( oQe$ )
CreateUnoService("com.sun.star.frame.DispatchHelper") _
.executeDispatch(ThisComponent.CurrentController.Frame, ".uno:" & oQe & "", "", 0, Array())
End Sub

Link para o comentário
Compartilhar em outros sites

  • 4 meses depois...

@Schiavinatto Bom dia, 

Eu aqui de novo te dando trabalho.

 

Você criou está Macro - LibreOffice - para mim a alguns meses, e lhe agradeço pois estou utilizando muito e me otimizou demais o trabalho.

 

No entanto, há um erro nela, não sei se eu fiz algo errado.

 

Ao finalizar o procedimento - recorta e cola - ao final da planilha, ela volta ao início da planilha e faz novamente o procedimento para as primeira 10 a 15 linhas encontradas conforme o que se pede a Macro.

 

Não sei se você tem tempo pra me ajudar com isso meu amigo, mas se houver a possibilidade...

 

Outra coisa, é que eu gostaria que houvesse uma outro procedimento, além de recortar a linha especifica colando abaixo no local indicado pela Macro, eu gostaria que na mesma linha porém á coluna a esquerda a Macro copiasse apenas o número constante na célula, número que se refere ao código da minha conta contábil.

 

Eis a Macro:

 

REM  *****  BASIC  *****

sub XPTO
    GoToCel "B1"
Dim oSel as Object
Dim Var1 As integer
Dim Var2 As Integer
Dim Var3 As String
oSel = ThisComponent.getCurrentSelection()
Var1 = oSel.getString()

    For Var2 = 1 To Var1 Step 1
    Procurar
Execute "Cut"
Execute "GoDown"

'====
oSel = ThisComponent.getCurrentSelection()
Var3 = oSel.getString()
    While Var3 <> ""  
Execute "GoDown"
oSel = ThisComponent.getCurrentSelection()
Var3 = oSel.getString()
    Wend
    
Execute "Paste"
Execute "GoDown"
    Next
End Sub


'-----------------------
'        SubMacros
'-----------------------

Sub Procurar
dim args1(20) as new com.sun.star.beans.PropertyValue
args1(0).Name = "SearchItem.StyleFamily"
args1(0).Value = 2
args1(1).Name = "SearchItem.CellType"
args1(1).Value = 0
args1(2).Name = "SearchItem.RowDirection"
args1(2).Value = true
args1(3).Name = "SearchItem.AllTables"
args1(3).Value = false
args1(4).Name = "SearchItem.SearchFiltered"
args1(4).Value = false
args1(5).Name = "SearchItem.Backward"
args1(5).Value = false
args1(6).Name = "SearchItem.Pattern"
args1(6).Value = false
args1(7).Name = "SearchItem.Content"
args1(7).Value = false
args1(8).Name = "SearchItem.AsianOptions"
args1(8).Value = false
args1(9).Name = "SearchItem.AlgorithmType"
args1(9).Value = 0
args1(10).Name = "SearchItem.SearchFlags"
args1(10).Value = 0
args1(11).Name = "SearchItem.SearchString"
args1(11).Value = "Conta:"
args1(12).Name = "SearchItem.ReplaceString"
args1(12).Value = ""
args1(13).Name = "SearchItem.Locale"
args1(13).Value = 255
args1(14).Name = "SearchItem.ChangedChars"
args1(14).Value = 2
args1(15).Name = "SearchItem.DeletedChars"
args1(15).Value = 2
args1(16).Name = "SearchItem.InsertedChars"
args1(16).Value = 2
args1(17).Name = "SearchItem.TransliterateFlags"
args1(17).Value = 256
args1(18).Name = "SearchItem.Command"
args1(18).Value = 0
args1(19).Name = "SearchItem.SearchFormatted"
args1(19).Value = false
args1(20).Name = "SearchItem.AlgorithmType2"
args1(20).Value = 1
createUnoService("com.sun.star.frame.DispatchHelper") _
.executeDispatch(ThisComponent.CurrentController.Frame, ".uno:ExecuteSearch", "", 0, args1())
End Sub


Sub GoToCel ( xLocal$ )
dim args1(0) as new com.sun.star.beans.PropertyValue : args1(0).Name = "ToPoint" : args1(0).Value = xLocal
CreateUnoService("com.sun.star.frame.DispatchHelper") _
.executeDispatch(ThisComponent.CurrentController.Frame, ".uno:GoToCell", "", 0, args1())
End Sub


Sub Execute ( oQe$ )
CreateUnoService("com.sun.star.frame.DispatchHelper") _
.executeDispatch(ThisComponent.CurrentController.Frame, ".uno:" & oQe & "", "", 0, Array())
End Sub

 

Planilha sem os procedimentos

image.png.0ab1019ce1498fc43eb6cfe2cf07ac88.png


Planilha com os procedimentos
 


image.png.a2f04027708d2b524dcf96b4e348ed50.png

 

 

Link para o comentário
Compartilhar em outros sites

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

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

×
×
  • Criar novo...