Eu tinha uma planilha para completar, com cerca de mil linhas. 180 dessas linhas estavam com 3 das 4 células em branco, à espera da complementação. Havia uma tabela à parte, com os dados que faltavam na tabela maior.
Na foto abaixo aparecem, nas 4 primeiras colunas, o início da tabela a ser completada. Notem os espaços em branco, que ressaltei com molduras em vermelho. Nesses primeiros 6 registros eu devia encaixar, por macro, os dados da tabela à direita, menos, é claro, os nomes (coluna G), que já constavam na tabela maior.
Elaborei uma macro (dentro do Calc LibreOffice) que localizasse, na tabela maior, o primeiro nome da tabela menor. Em seguida, devia a macro copiar o conteúdo das três células à direita do nome e colá-las à direita do mesmo nome constante da tabela incompleta. Era o caso de trabalhar com cópia e colagem, não de células individuais, mas de uma faixa de células (CellRange). Eis a macro:
Sub Main
Dim oDoc As Object
Dim oSheet As Object
Dim Cell As Object
Dim iCol, iCol2 As Integer
Dim iLin, iLin2 As Integer
Dim oRange1(6 to 8 , 2), oRange2(1 to 3 , 2)
Dim nome1, nome2 As String
oDoc = ThisComponent
oSheet = oDoc.Sheets(0)
iCol = 6
iLin = 2
iCol2 = 1
iLin2 = 2
nome1 = “A”
nome2 = “B”
While iLin < 8 and nome2 <> “” and nome1 <> “”
ReDim oRange1(1 to 3 , iLin), oRange2(6 to 8 , iLin)
oCell = oSheet.getCellByPosition(iCol,iLin)
nome1 = oCell.String
oCell = oSheet.getCellByPosition(iCol2, iLin2)
nome2 = oCell.String
If nome1 = nome2 Then
oRange1 = oSheet.getCellRangeByPosition(7,iLin,9,iLin)
oRange2 = oSheet.getCellRangeByPosition(2,iLin2,4,iLin2)
oRange2.setDataArray(oRange1.getDataArray())
iLin = iLin + 1
End If
iLin2 = iLin2 + 1
Wend
End Sub
Esta versão da macro está adaptada ao tamanho reduzido aqui exposto, isto é, só trabalha até transpor os dados do sexto nome da tabela menor.
Importante notar que na declaração das variáveis oRange1 e oRange2, é preciso especificar o conjunto de células de cada uma. No caso, ambas têm 3 colunas e 1 linha. Dim oRange1(1 to 3, 2) e Dim oRange2(6 to 8, 2) indicam as primeiras posições das duas faixas. Não esquecer que a contagem das linhas e colunas começa com zero (0) e não com 1.
ReDim é necessário para que os parâmetros (célula inicial e célula final das faixas) possam mudar de acordo com as exigências do programa. Assim, quando o programa chegar ao segundo nome da tabela menor (ADILSON), teremos oRange1(6 to 8, 3), mudança da linha.
Rodada a macro, a página ficará assim:
Estive consultando o Basic Development Guide, e lá constatei que existe uma outra maneira de obter o resultado acima, só que apagando os dados copiados para a tabela inicialmente incompleta. Adaptei a macro acima, ficando ela assim:
Sub Main
Dim Doc As Object
Dim Cell, Sheet As Object
Dim CellRangeAddress As New com.sun.star.table.CellRangeAddress
Dim CellAddress As New com.sun.star.table.CellAddress
Dim iLin, iLin2, contador As Integer
Dim nome1, nome2 As String
Doc = StarDesktop.CurrentComponent
Sheet = Doc.Sheets(0)
iLin = 2
iLin2 = 2
contador = 0
nome1 = “A”
nome2 = “B”
While contador < 27
Cell = Sheet.getCellByPosition(6,iLin)
nome1 = Cell.String
Cell = Sheet.getCellByPosition(1,iLin2)
nome2 = Cell.String
msgbox nome1 & nome2
If nome1 = nome2 Then
CellRangeAddress.Sheet = 0
CellRangeAddress.StartColumn = 7
CellRangeAddress.StartRow = iLin
CellRangeAddress.EndColumn = 9
CellRangeAddress.EndRow = iLin
CellAddress.Sheet = 0
CellAddress.Column = 2
CellAddress.Row = iLin2
Sheet.moveRange(CellAddress, CellRangeAddress)
iLin = iLin + 1
iLin2 = iLin2 + 1
Else
iLin2 = iLin2 + 1
End If
contador = contador + 1
Wend
End Sub
Com essa macro, aquela página inicial ficará assim:
Blog Timblindim 