Calc: Copy one Cell to each cell in a CellRange

Lupp · Post by **Lupp** » Thu Sep 06, 2018 12:58 am

===Edit 2018-09-06 11:16 CEST===
I attach a slightly reworked example. The code there is containing a somehow enhanced way to provide the working Sub with parameter values for the testing. The relevant part of the code for copying is unchanged, but the UndoManager not used for testing now.

copyOneCellToRange_2.ods: (17.13 KiB) Downloaded 385 times

===End Edit===

===Edit 2018-09-12 09:50 CEST===
Each of the scripts below contained the same error in one place: "pTarget" instead of "pTargetRg". That's fixed now.
Clarification: The first two Sub are mainly for demonstration of inefficiency - and for shortness. The third one may be efficient enough in many cases. A replacement using the CellRange method. .FillAuto should be considered.
===End Edit===

(Sorry if there was already a thread of similar content in this branch of the forum. I checked but found none.)
The three solutions are also contained in the attached example. You may play with it to compare the efficiency.

Disclaimer: No guarantee of any kind. The Sub are only superficially tested.
Note: If the source contains a formula complications of many kinds are to be expected.
In fact I doubt if there will be many cases of useful application. Efficiency of algorithms is somehow attractive anyway, isn't it?

Recently there was the thread viewtopic.php?f=20&t=94941 in the Calc branch which induced considerations leading me to the current topic. There is no built-in function for the purpose.

A first approach is, to create the cells of the target range one by one and to copy the source to eah one in an extra step. Two nested For-loops, e.g. needed. This works, of course, but can be expected to be rather slow. (See remark at the end.)

A first enhancement can be, to only fill the cells of the first column of the target range one by one, and then to copy this column as a whole by additional steps one by one to the remaining columns. (Rows / columns exchangeable basically.) This is surely faster, but for large ranges still not fully satisfying.

An approach to a solution really fast alo for very large ranges can act in a similar way as powers to integer exponents were calculated when efficiency in machine arithmetic was relevant: Try to double the accomplished part of the task with every step. This part will grow then exponentially for most of the time. In our case all the rest can in fact be done in two additional steps.

Here I give first the "naive" solution:

Code: Select all

Sub myCopyPaste(pSourceC As Object, pTargetRg As Object)
REM SourceCell, TargetRange to pass as partameters. 
arbSheet = pTargetRg.Spreadsheet
uMgr     = ThisComponent.UndoManager
uMgr.EnterUndoContext("Multicopy")
With pTargetRg.RangeAddress
For x = 0 To .EndColumn -.StartColumn
  For y = 0 To .EndRow -.StartRow
    targetC = pTargetRg.GetCellByPosition(x, y)
    arbSheet.copyRange(targetC.CellAddress, pSourceC.RangeAddress)
    REM Any existing sheet can do this. The document itself, however, doesn't know the method.
  Next y
Next x
End With
uMgr.LeaveUndoContext()
End Sub

Now the solution enhanced by introducing columns as secondary source:

Code: Select all

Sub myFasterCopyPaste(pSourceC As Object, pTargetRg As Object)
arbSheet = pTargetRg.Spreadsheet
uMgr     = ThisComponent.UndoManager
uMgr.EnterUndoContext("Multicopy")
With pTargetRg.RangeAddress
For y = 0 To .EndRow - .StartRow
  targetCell = pTargetRg.GetCellByPosition(0, y)
  arbSheet.copyRange(targetCell.CellAddress, pSourceC.RangeAddress)
Next y
sourceCol = pTargetRg.GetCellRangeByPosition(0, 0, 0, .EndRow - .StartRow)
For x = 1 To .EndColumn - .StartColumn
  targetCell = pTargetRg.GetCellByPosition(x, 0)
  arbSheet.copyRange(targetCell.CellAddress, sourceCol.RangeAddress)
Next x
End With
uMgr.LeaveUndoContext()
End Sub

More code lines, but second to none in efficiency for large target ranges now the "exponential" solution:

Code: Select all

Sub myFastestCopyPaste(pSourceC As Object, pTargetRg As Object)
arbSheet = pTargetRg.Spreadsheet
uMgr     = ThisComponent.UndoManager
uMgr.EnterUndoContext("Multicopy")
currTargetC = pTargetRg.GetCellByPosition(0, 0)
arbSheet.copyRange(currTargetC.CellAddress, pSourceC.RangeAddress)
With pTargetRg.RangeAddress
nCols = .EndColumn - .StartColumn +1
nRows = .EndRow    - .StartRow    + 1
kR = 1 : remainRows = nRows - 1
Do While kR<=remainRows
  currTargetC = pTargetRg.GetCellByPosition(0, kR)
  currSource  = pTargetRg.GetCellRangeByPosition(0, 0, 0, kR - 1) 
  arbSheet.copyRange(currTargetC.CellAddress, currSource.RangeAddress)
  remainRows = remainRows - kR : kR = kR*2
Loop
If remainRows>0 Then
  currSource  = pTargetRg.GetCellRangeByPosition(0, 0, 0, remainRows - 1)
  currTargetC = pTargetRg.GetCellByPosition(0, kR)
  arbSheet.copyRange(currTargetC.CellAddress, currSource.RangeAddress)
End If
kC = 1 : remainCols = nCols - 1
Do While kC<=remainCols
  currTargetC = pTargetRg.GetCellByPosition(kC, 0)
  currSource  = pTargetRg.GetCellRangeByPosition(0, 0, kC - 1, nRows - 1) 
  arbSheet.copyRange(currTargetC.CellAddress, currSource.RangeAddress)
  remainCols  = remainCols - kC : kC = kC*2
Loop
If remainCols>0 Then
  currSource  = pTargetRg.GetCellRangeByPosition(0, 0, remainCols - 1, nRows - 1)
  currTargetC = pTargetRg.GetCellByPosition(kC, 0)
  arbSheet.copyRange(currTargetC.CellAddress, currSource.RangeAddress)
End If
End With
uMgr.LeaveUndoContext()
End Sub

The code is also contained in the attached demo.
BTW: AOO 4.1.5 executes the "naive" routine by a high factor faster than LibO 6.1.1.1RC. Well, thats an RC.