Pergunte aqui
1

Copiar uma Linha e Colar em n Linhas

perguntadas 2019-03-29 20:12:47 +0100

imagem do gravatar de Conrado

updated 2019-09-30 19:03:46 +0100

Pessoal,

Possuo uma planilha onde o total de linhas será variáveis (n) conforme dados extraídos de um site.

Possuo um range de células (Z2:AF2), onde contém fórmulas para fazer a validação de informações.

Tem alguma forma de copiar Z2:AF2 e colar em Z3:AF"n" ?

Os procedimentos que encontrei, referência apenas uma célula destinatária, e não um grupo de células. Para isso teria que fazer um looping, porém inviável, pois possui 8000 linhas =[

editar alterar tag assinalar como ofensivo fechar mesclar Excluir

4 Respostas

1

respondidas 2019-04-01 13:39:52 +0100

imagem do gravatar de Conrado

@Gilberto Schiavinatto e @mrkalvin

Gilberto...cheguei neste procedimento utilizando o gravador de macros, e fiz as adaptações que precisava. Consegui colocar a última linha como variável do procedimento para que ele selecione até a linha que desejo e depois cole as informações. A única coisa ruim, é que ele fica com a primeira linha selecionável, mesmo utilizando o gravador e clicando ESC, mas isso eu corrigi no passo a passo para o usuário para que não desse problemas.

mrkalvin, infelizmente o loop fica muito pesado, tente executar em loop e demorou mais de 05 min para percorrer 5600 linhas aproximadamente, e esse número vai aumentar a cada mês.

Segue abaixo o procedimento que gravei/adaptei. Caso tenham sugestões, fico contente =]

sub Copiar_Colar_Formulas
rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
rem esta é a variável que criei
dim LastRow as Long
rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem aqui é identificado a ultima linha das informações
LastRow = Ultima_Linha_Dados_Finais + 1

rem ----------------------------------------------------------------------
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "ToPoint"
args1(0).Value = "$Z$2:$AF$2"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())

rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())

rem ----------------------------------------------------------------------
dim args3(0) as new com.sun.star.beans.PropertyValue
args3(0).Name = "ToPoint"

rem aqui é a adaptação que fiz. Não sabia que podia fazer isso neste modo
args3(0).Value = "$Z$3:$AF$" & LastRow

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args3())

rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:Paste", "", 0, Array())

rem ----------------------------------------------------------------------
dim args5(0) as new com.sun.star.beans.PropertyValue
args5(0).Name = "ToPoint"
args5(0).Value = "$A$1"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args5())

rem aqui é o processo para retirar a evidência da cópia, mas não funciona
rem ----------------------------------------------------------------------
rem dispatcher.executeDispatch(document, ".uno:TerminateInplaceActivation", "", 0, Array())

rem ----------------------------------------------------------------------
rem dispatcher.executeDispatch(document, ".uno:Cancel", "", 0, Array())

rem ----------------------------------------------------------------------
rem dispatcher.executeDispatch(document, ".uno:TerminateInplaceActivation", "", 0, Array())

rem ----------------------------------------------------------------------
rem dispatcher.executeDispatch(document, ".uno:Cancel", "", 0, Array())

rem ----------------------------------------------------------------------
dim args10(0) as new com.sun.star.beans.PropertyValue
args10(0).Name = "ToPoint"
args10(0).Value = "$A$1"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args10())

End Sub
editar assinalar como ofensivo Excluir Link mais
1

respondidas 2019-03-29 20:46:13 +0100

updated 2019-03-29 21:34:39 +0100

Ola @Conrado, feito com gravador de macro:

Nomeei a range Z2:AF2 para rangeZAF (as fórmulas) e considerando que a coluna Y não tenha célula vazia.

Dependendo da complexidade da formula, a resposta poderá ser demorada...

sub Main
'-----------------
dim document   as object
dim dispatcher as object
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "ToPoint"
args1(0).Value = "rangeZAF"
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())
dim args3(1) as new com.sun.star.beans.PropertyValue
args3(0).Name = "By"
args3(0).Value = 1
args3(1).Name = "Sel"
args3(1).Value = false
dispatcher.executeDispatch(document, ".uno:GoLeft", "", 0, args3())
dispatcher.executeDispatch(document, ".uno:GoDownToEndOfData", "", 0, Array())
dispatcher.executeDispatch(document, ".uno:GoRight", "", 0, Array())
dispatcher.executeDispatch(document, ".uno:GoUpToStartOfDataSel", "", 0, Array())
dispatcher.executeDispatch(document, ".uno:Paste", "", 0, Array())
dispatcher.executeDispatch(document, ".uno:GoUp", "", 0, Array())
dispatcher.executeDispatch(document, ".uno:GoUpToStartOfData", "", 0, Array())
end sub
editar assinalar como ofensivo Excluir Link mais
1

respondidas 2019-03-31 01:50:53 +0100

imagem do gravatar de mrkalvin

updated 2019-03-31 01:53:39 +0100

Arquivo de exemplo: C:\fakepath\loop.ods

Veja se o loop é inviável para seu uso:

sub copiar_colar_comFormula

    Dim oDoc, oPlanAtiva As Object
    oDoc = ThisComponent
    oPlanAtiva = oDoc.CurrentController.ActiveSheet

    oOrigem = oPlanAtiva.getCellRangeByPosition(0,0,5,0).getRangeAddress()

    'll = 2
    For ll= 1 to 4
    'For ll= 1 to 7998
        oDestino = oPlanAtiva.getCellByPosition(0,ll).getCellAddress()
        oPlanAtiva.copyRange(oDestino , oOrigem)
    Next ll

    msgbox "Pronto!"
End sub



sub copiar_colar_soValor

    Dim oDoc, oPlanAtiva As Object
    oDoc = ThisComponent
    oPlanAtiva = oDoc.CurrentController.ActiveSheet

    oOrigem = oPlanAtiva.getCellRangebyName("A1:F1")
    arr = oOrigem.getDataArray()

    'll = 2
    For ll= 2 to 5
    'For ll= 2 to 7999
        oDestino = oPlanAtiva.getCellRangebyName("$A" & ll & ":F" & ll)
        oDestino.setDataArray(arr)
    Next ll

    msgbox "Pronto!"
End sub
editar assinalar como ofensivo Excluir Link mais
1

respondidas 2019-04-04 01:11:27 +0100

imagem do gravatar de Seiki2000

Olá Conrado,

Tenho esse modelo.

Voce pode adaptar com uma condicional e ou loop.

Espero que ajude.

 Sub COPIARLINHAS

 Dim oDoc As Object, oPlan As Object

 Dim oCopyRange as Object

 Dim oPasteRange as Object

 oDoc = ThisComponent

 oPlanOrigem = oDoc.Sheets.getByName("PLAN1") ' DEFINO A PLANILHA DE ORIGEM

 oPlanDestino = oDoc.Sheets.getByName("PLAN2") ' DEFINO A PLANILHA DESTINO

 LinhaOrigem = 1

 LinhaDestino = 1

' INTERVALO A SER COPIADO
oCopyRange = oPlanOrigem.getCellRangeByPosition(0, LinhaOrigem - 1, 18, LinhaOrigem - 1).getRangeAddress()
' POSIÇÃO A SER COLADA
oPasteRange = oPlanDestino.getCellByPosition(0, LinhaDestino).getCellAddress()  
oPlanDestino.CopyRange(oPasteRange, oCopyRange)
End Sub
editar assinalar como ofensivo Excluir Link mais

Comentários

@Seiki2000 Obrigado pelo exemplo....o processo de Loop (for next - do while etc) já conheço bem. O problema é a quantidade de operações, que ficaria extremamente inviável. Exemplo: 01 mês de dados ±1800 linhas, 03 meses ± 8900 linhas. Quando fiz o loop, levou 50 min para rodar tudo. Não tenho uma máquina na empresa com auto poder de processamento =(

imagem do gravatar de ConradoConrado ( 2019-04-04 14:03:18 +0100 )editar
1

Conrado, sei como é isso. Tenho um relatório de quase 15.000 linhas onde faço pesquisa buscando dados em outro relatório. Na máquina empresa demora demais. Mas não tem outro jeito. Mesmo assim, no meu caso, ainda é produtivo e principalmente assertivo.

imagem do gravatar de Seiki2000Seiki2000 ( 2019-04-06 00:24:35 +0100 )editar
Login/Registrar para responder

Ferramentas de perguntas

1 seguidor

Estatísticas

Perguntadas: 2019-03-29 20:12:47 +0100

Lidas: 70 vezes

Última atualização: Apr 04