wizards/source/sfdocuments/SF_Calc.xba | 258 +++++++++++++++++++++++----------
1 file changed, 180 insertions(+), 78 deletions(-)
New commits:
commit 9f4405c94bc7d9d7500aedc1ade2d90955ab69d7
Author: Jean-Pierre Ledure <j...@ledure.be>
AuthorDate: Tue Aug 16 16:13:40 2022 +0200
Commit: Jean-Pierre Ledure <j...@ledure.be>
CommitDate: Wed Aug 17 14:01:07 2022 +0200
ScriptForge - (Calc) redesign CompactUp() and CompactLeft()
This commit is mainly about the introduction of
a new internal method:
_ComputeFilter(range, filterformula, filterscope)
A FilterFormula is a Calc formula that returns TRUE or FALSE
The formula is expressed in terms of
- the top-left cell of the range when FilterScope = "CELL"
- the topmost row of the range when FilterScope = "ROW"
- the leftmost column of the range when FilterScope = "COLUMN"
After pasting, the relative and absolute references
will be interpreted correctly.
The FilterScope indicates the way the formula is applied,
once by row, column or individual cell.
The concept of FilterFormula was already used by CompactUp()
and CompactLeft(). Their implicit (Filter)scopes were resp.
"ROW" and "COLUMN".
The _ComputeFilter() method returns an array of subranges
contained in the initial range that match the filter.
The isolation the code for the management of filters
applied on ranges makes the later use of the concepts of
FilterFormula and FilterScope reusable for other methods.
CompactUp() and CompactLeft() are functionally unchanged.
No impact on documentation.
Change-Id: I7c4e890b54f315486f29b5434a3c236167e2f9ea
Reviewed-on: https://gerrit.libreoffice.org/c/core/+/138368
Tested-by: Jean-Pierre Ledure <j...@ledure.be>
Reviewed-by: Jean-Pierre Ledure <j...@ledure.be>
Tested-by: Jenkins
diff --git a/wizards/source/sfdocuments/SF_Calc.xba
b/wizards/source/sfdocuments/SF_Calc.xba
index b929faccd58c..61d1691f7d43 100644
--- a/wizards/source/sfdocuments/SF_Calc.xba
+++ b/wizards/source/sfdocuments/SF_Calc.xba
@@ -45,6 +45,7 @@ Option Explicit
''' ' The substring
"SFDocuments." in the service name is optional
'''
''' Definitions:
+'''
''' Many methods require a
"Sheet" or a "Range" as argument. (NB: a single cell is
considered as a special case of a Range)
''' Usually, within a specific Calc
instance, sheets and ranges are given as a string: "SheetX" and
"D2:F6"
''' Multiple ranges are not supported in
this context.
@@ -71,6 +72,21 @@ Option Explicit
'''
myDoc.Range("SheetX.D2:F6")
'''
A range within the sheet SheetX in file associated with
the myDoc Calc instance
'''
+''' Several methods may receive a
"FilterFormula" as argument.
+''' A FilterFormula may be associated with
a FilterScope: "row", "column" or "cell".
+''' These arguments determines on which
rows/columns/cells of a range the method should be applied
+''' Examples:
+'''
oDoc.ClearAll("A1:J10", FilterFormula := "=(A1<=0)",
FilterScope := "CELL") ' Clear all negative values
+'''
oDoc.ClearAll("A2:J10", FilterFormula := "=(A2<>A1)",
FilterScope := "COLUMN") ' Clear when identical to above
cell
+'''
+''' FilterFormula: a Calc formula
that returns TRUE or FALSE
+'''
the formula is expressed in terms of
+'''
- the top-left cell of the range when FilterScope = "CELL"
+'''
- the topmost row of the range when FilterScope = "ROW"
+'''
- the leftmost column of the range when FilterScope = "COLUMN"
+'''
relative and absolute references will be interpreted correctly
+''' FilterScope: the way the
formula is applied, once by row, by column, or by individual cell
+'''
''' Detailed user documentation:
'''
https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_calc.html?DbPAR=BASIC
'''
@@ -544,7 +560,7 @@ Const cstSubArgs = "Range"
Check:
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
If Not _IsStillAlive() Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Range, "Range",
V_STRING) Then GoTo Finally
+ If Not ScriptForge.SF_Utils._Validate(Range, "Range",
Array(V_STRING, ScriptForge.V_OBJECT)) Then GoTo Finally
End If
Try:
@@ -560,7 +576,7 @@ Try:
+ .OBJECTS _
+ .EDITATTR _
+ .FORMATTED
- Set oRange = _ParseAddress(Range)
+ If VarType(Range) = V_STRING Then Set oRange =
_ParseAddress(Range) Else Set oRange = Range
oRange.XCellRange.clearContents(lClear)
End With
@@ -663,9 +679,9 @@ Public Function CompactLeft(Optional ByVal Range As Variant
_
''' WholeColumn: when True (default = False), erase
whole columns
''' FilterFormula: the formula to be applied on
each column.
''' The column is erased when the formula
results in True,
-''' The formula shall probably involve one
or more cells of the first column of the range..
+''' The formula shall probably involve one
or more cells of the first column of the range.
''' By default, a column is erased when all
the cells of the column are empty,
-''' i.e. suppose the range is
"A1:J200" (height = 0) the default value becomes
+''' i.e. suppose the range is
"A1:J200" (height = 200) the default value becomes
'''
"=(COUNTBLANK(A1:A200)=200)"
''' Returns:
''' A string representing the location of the
initial range after compaction,
@@ -676,13 +692,12 @@ Public Function CompactLeft(Optional ByVal Range As
Variant _
''' ' The columns having a
"X" in row 7 are completely suppressed
Dim sCompact As String ' Return value
-Dim oSourceAddress As Object ' Alias of Range as _Address
-Dim lLastRow As Long ' Last used row number in the
sheet containing Range
-Dim sFormulaRange As String ' Range, as a string, where the
FilterFormula must be stored
-Dim vCompact As Variant ' Array of Boolean values
indicating which columns should be erased
+Dim oCompact As Object ' Return value as an _Address type
Dim lCountDeleted As Long ' Count the deleted columns
-Dim lCountToDelete As Long ' Count contiguous columns to be
deleted at once
-Dim sPartialRange As String ' Contiguous columns to be deleted
+Dim vCompactRanges As Variant ' Array of ranges to be compacted based
on the formula
+Dim oSourceAddress As Object ' Alias of Range as _Address
+Dim oPartialRange As Object ' Contiguous columns to be deleted
+Dim sShiftRange As String ' Contiguous columns to be shifted
Dim i As Long
Const cstThisSub = "SFDocuments.Calc.CompactLeft"
@@ -703,48 +718,34 @@ Check:
Try:
Set oSourceAddress = _ParseAddress(Range)
+ lCountDeleted = 0
With oSourceAddress
' Set the default formula => all cells are blank
If FilterFormula = "" Then FilterFormula =
Printf("=(COUNTBLANK(%C1%R1:%C1%R2)-" & .Height &
"=0)", Range)
- ' Compute the range where to apply the formula
- lLastRow = LastRow(.SheetName)
- sFormulaRange = Offset(Range, lLastRow -
.XCellRange.RangeAddress.StartColumn + 1, , 1)
- SetFormula(sFormulaRange, FilterFormula)
- ' Get the columns to compact: 0 = False, 1 = True
- vCompact = GetValue(sFormulaRange)
- If Not IsArray(vCompact) Then vCompact = Array(vCompact)
- ClearAll(sFormulaRange)
-
- ' Iterates from the last to the first column of the range
and remove the columns that match the filter
- ' by groups of contiguous columns
- lCountDeleted = 0
- lCountToDelete = 0
- For i = UBound(vCompact) To 0 Step -1
- If vCompact(i) = 1 Then lCountToDelete = lCountToDelete
+ 1
- If i > 0 And vCompact(i) = 1 Then
- ' Do nothing
- ElseIf lCountToDelete > 0 Then '
The current column must be kept but columns at the left must be removed
- ' Do not forget when the 1st column must
be removed
- sPartialRange = Offset(Range, , Iif(i = 0 And
vCompact(i) = 1, 0, i + 1), , lCountToDelete)
- ShiftLeft(sPartialRange, WholeColumn)
- lCountDeleted = lCountDeleted + lCountToDelete
- lCountToDelete = 0
- End If
- Next i
+ ' Identify the ranges to compact based on the given
formula
+ vCompactRanges = _ComputeFilter(oSourceAddress, FilterFormula,
"COLUMN")
+
+ ' Iterate through the ranges from bottom to top and shift
them up
+ For i = UBound(vCompactRanges) To 0 Step -1
+ Set oPartialRange = vCompactRanges(i)
+ ShiftLeft(oPartialRange.RangeName, WholeColumn)
+ lCountDeleted = lCountDeleted + oPartialRange.Width
+ Next i
+
' Compute the final range position
- If lCountDeleted < .Width Then sCompact = Offset(Range, 0,
0, , .Width - lCountDeleted)
+ If lCountDeleted < .Width Then sCompact = Offset(Range, 0,
0, 0, .Width - lCountDeleted)
- ' Push rightwards the cells that migrated leftwards
irrelevantly
+ ' Push to the right the cells that migrated leftwards
irrelevantly
If Not WholeColumn Then
If Len(sCompact) > 0 Then
- sPartialRange = Offset(sCompact, 0, .Width -
lCountDeleted, , lCountDeleted)
+ sShiftRange = Offset(sCompact, 0, .Width -
lCountDeleted, , lCountDeleted)
Else
- sPartialRange = .RangeName
+ sShiftRange = .RangeName
End If
- ShiftRight(sPartialRange, WholeColumn := False)
+ ShiftRight(sShiftRange, WholeColumn := False)
End If
End With
@@ -773,7 +774,7 @@ Public Function CompactUp(Optional ByVal Range As Variant _
''' WholeRow: when True (default = False), erase
whole rows
''' FilterFormula: the formula to be applied on
each row.
''' The row is erased when the formula
results in True,
-''' The formula shall probably involve one
or more cells of the first row of the range..
+''' The formula shall probably involve one
or more cells of the first row of the range.
''' By default, a row is erased when all
the cells of the row are empty,
''' i.e. suppose the range is
"A1:J200" (width = 10) the default value becomes
'''
"=(COUNTBLANK(A1:J1)=10)"
@@ -786,13 +787,12 @@ Public Function CompactUp(Optional ByVal Range As Variant
_
''' ' The rows having a "X"
in column G are completely suppressed
Dim sCompact As String ' Return value
-Dim oSourceAddress As Object ' Alias of Range as _Address
-Dim lLastCol As Long ' Last used column number in the
sheet containing Range
-Dim sFormulaRange As String ' Range, as a string, where the
FilterFormula must be stored
-Dim vCompact As Variant ' Array of Boolean values
indicating which rows should be erased
+Dim oCompact As Object ' Return value as an _Address type
Dim lCountDeleted As Long ' Count the deleted rows
-Dim lCountToDelete As Long ' Count contiguous rows to be
deleted at once
-Dim sPartialRange As String ' Contiguous rows to be deleted
+Dim vCompactRanges As Variant ' Array of ranges to be compacted based
on the formula
+Dim oSourceAddress As Object ' Alias of Range as _Address
+Dim oPartialRange As Object ' Contiguous rows to be deleted
+Dim sShiftRange As String ' Contiguous rows to be shifted
Dim i As Long
Const cstThisSub = "SFDocuments.Calc.CompactUp"
@@ -813,48 +813,34 @@ Check:
Try:
Set oSourceAddress = _ParseAddress(Range)
+ lCountDeleted = 0
With oSourceAddress
' Set the default formula => all cells are blank
If FilterFormula = "" Then FilterFormula =
Printf("=(COUNTBLANK(%C1%R1:%C2%R1)-" & .Width &
"=0)", Range)
- ' Compute the range where to apply the formula
- lLastCol = LastColumn(.SheetName)
- sFormulaRange = Offset(Range, , lLastCol -
.XCellRange.RangeAddress.StartRow + 1, , 1)
- SetFormula(sFormulaRange, FilterFormula)
- ' Get the rows to compact: 0 = False, 1 = True
- vCompact = GetValue(sFormulaRange)
- If Not IsArray(vCompact) Then vCompact = Array(vCompact)
- ClearAll(sFormulaRange)
-
- ' Iterates from the last to the first row of the range
and remove the rows that match the filter
- ' by groups of contiguous rows
- lCountDeleted = 0
- lCountToDelete = 0
- For i = UBound(vCompact) To 0 Step -1
- If vCompact(i) = 1 Then lCountToDelete = lCountToDelete
+ 1
- If i > 0 And vCompact(i) = 1 Then
- ' Do nothing
- ElseIf lCountToDelete > 0 Then '
The current row must be kept but rows below must be removed
- ' Do not forget when the 1st row must be
removed
- sPartialRange = Offset(Range, Iif(i = 0 And
vCompact(i) = 1, 0, i + 1), , lCountToDelete)
- ShiftUp(sPartialRange, WholeRow)
- lCountDeleted = lCountDeleted + lCountToDelete
- lCountToDelete = 0
- End If
- Next i
+ ' Identify the ranges to compact based on the given
formula
+ vCompactRanges = _ComputeFilter(oSourceAddress, FilterFormula,
"ROW")
+
+ ' Iterate through the ranges from bottom to top and shift
them up
+ For i = UBound(vCompactRanges) To 0 Step -1
+ Set oPartialRange = vCompactRanges(i)
+ ShiftUp(oPartialRange.RangeName, WholeRow)
+ lCountDeleted = lCountDeleted + oPartialRange.Height
+ Next i
+
' Compute the final range position
- If lCountDeleted < .Height Then sCompact = Offset(Range, 0,
0, .Height - lCountDeleted)
+ If lCountDeleted < .Height Then sCompact = Offset(Range, 0,
0, .Height - lCountDeleted, 0)
' Push downwards the cells that migrated upwards
irrelevantly
If Not WholeRow Then
If Len(sCompact) > 0 Then
- sPartialRange = Offset(sCompact, .Height -
lCountDeleted, 0, lCountDeleted)
+ sShiftRange = Offset(sCompact, .Height -
lCountDeleted, 0, lCountDeleted)
Else
- sPartialRange = .RangeName
+ sShiftRange = .RangeName
End If
- ShiftDown(sPartialRange, WholeRow := False)
+ ShiftDown(sShiftRange, WholeRow := False)
End If
End With
@@ -2874,7 +2860,7 @@ Const cstSubArgs = "TargetRange, Formula"
Check:
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
If Not _IsStillAlive() Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(TargetRange,
"TargetRange", V_STRING) Then GoTo Finally
+ If Not ScriptForge.SF_Utils._Validate(TargetRange,
"TargetRange", Array(V_STRING, ScriptForge.V_OBJECT)) Then GoTo
Finally
If IsArray(Formula) Then
If Not ScriptForge.SF_Utils._ValidateArray(Formula,
"Formula", 0, V_STRING) Then GoTo Finally
Else
@@ -2883,7 +2869,7 @@ Check:
End If
Try:
- Set oAddress = _ParseAddress(TargetRange)
+ If VarType(TargetRange) = V_STRING Then Set oAddress =
_ParseAddress(TargetRange) Else Set oAddress = TargetRange
With oAddress
If IsArray(Formula) Then
' Convert to data array and limit its size to the
size of the initial range
@@ -3663,6 +3649,122 @@ End Function ' SFDocuments.SF_Calc.SetPrinter
REM =========================================================== PRIVATE
FUNCTIONS
+REM
-----------------------------------------------------------------------------
+Public Function _ComputeFilter(ByVal poRange As Object _
+ , ByVal
psFilterFormula As String _
+ , ByVal
psFilterScope As String _
+ ) As Variant
+''' Compute in the given range the cells, rows or columns
for which
+''' the given formula refurns TRUE
+''' Args:
+''' poRange: the range on which to compute the
filter as an _Address type
+''' psFilterFormula: the formula to be applied on
each row, column or cell
+''' psFilterSCope: "ROW",
"COLUMN" or "CELL"
+''' Returns:
+''' An array of ranges as objects of type _Address
+
+Dim vRanges As Variant ' Return value
+Dim oRange As Object ' A single vRanges() item
+Dim lLast As Long ' Last used row or column
number in the sheet containing Range
+Dim oFormulaRange As _Address ' Range where the FilterFormula must be
stored
+Dim sFormulaDirection As String ' Either V(ertical), H(orizontal)
or B(oth)
+Dim vDataArray As Variant ' DataArray compatible with
.DataArray UNO property
+Dim vFilter As Variant ' Array of Boolean values
indicating which rows should be erased
+Dim bFilter As Boolean ' A single item in vFilter
+Dim iDims As Integer ' Number of dimensions of
vFilter()
+Dim lLower As Long ' Lower level of
contiguous True filter values
+Dim lUpper As Long ' Upper level of
contiguous True filter values
+Dim i As Long, j As Long
+
+Check:
+ ' Error handling is determined by the calling method
+ vRanges = Array()
+
+Try:
+ With poRange
+
+ ' Compute the range where to apply the formula
+ ' Determine the direction of the range containing the
formula vertical, horizontal or both
+ Select Case psFilterScope
+ Case "ROW"
+ lLast = LastColumn(.SheetName)
+ ' Put formulas as a single column in the
unused area at the right of the range to filter
+ Set oFormulaRange = _Offset(poRange, 0, lLast -
.XCellRange.RangeAddress.StartColumn + 1, 0, 1)
+ sFormulaDirection = "V"
+ Case "COLUMN"
+ lLast = LastRow(.SheetName)
+ ' Put formulas as a single row in the
unused area at the bottom of the range to filter
+ Set oFormulaRange = _Offset(poRange, lLast -
.XCellRange.RangeAddress.StartRow + 1, 0, 1, 0)
+ sFormulaDirection = "H"
+ Case "CELL"
+ lLast = LastRow(.SheetName)
+ ' Put formulas as a matrix in the unused
area at the bottom of the range to filter
+ Set oFormulaRange = _Offset(poRange, lLast -
.XCellRange.RangeAddress.StartRow + 1, 0, 0, 0)
+ sFormulaDirection = "B"
+ If oFormulaRange.Width = 1 Then
+ sFormulaDirection = "V"
+ ElseIf oFormulaRange.Height = 1 Then
+ sFormulaDirection = "H"
+ End If
+ End Select
+
+ ' Apply the formula and get the result as an array of
Boolean values. Clean up
+ SetFormula(oFormulaRange, psFilterFormula)
+ vDataArray = oFormulaRange.XCellRange.getDataArray()
+ vFilter = _ConvertFromDataArray(vDataArray)
+ iDims = ScriptForge.SF_Array.CountDims(vFilter)
+ ClearAll(oFormulaRange)
+
+ ' Convert the filter values (0 = False, 1 = True) to a
set of ranges
+ Select Case iDims
+ Case -1 ' Scalar
+ If vFilter = 1 Then vRanges =
ScriptForge.SF_Array.Append(vRanges, poRange)
+ Case 0 ' Empty array
+ ' Nothing to do
+ Case 1, 2 ' Vector or Array
+ ' Strategy: group contiguous applicable
rows/columns to optimize heavy operations like CompactUp, CompactLeft
+ ' Stack the contiguous ranges of True
values in vRanges()
+
+ ' To manage vector and array with same
code, setup a single fictitious loop when vector, otherwise scan array by row
+ For i = 0 To Iif(iDims = 1, 0, UBound(vFilter,
1))
+ lLower = -1 : lUpper
= -1
+
+ For j = 0 To UBound(vFilter, iDims)
+ If iDims = 1 Then bFilter =
CBool(vFilter(j)) Else bFilter = CBool(vFilter(i, j))
+ If j = UBound(vFilter, iDims)
And bFilter Then ' Don't forget the last item
+ If lLower < 0 Then
lLower = j
+ lUpper = j
+ ElseIf Not bFilter Then
+ If lLower >= 0 Then
lUpper = j - 1
+ ElseIf bFilter Then
+ If lLower < 0 Then
lLower = j
+ End If
+ ' Determine the next
applicable range when one found and limit reached
+ If lUpper > -1 Then
+ If sFormulaDirection =
"V" Then ' ROW
+ Set oRange =
_Offset(poRange, lLower, 0, lUpper - lLower + 1, 0)
+ ElseIf
sFormulaDirection = "H" Then ' COLUMN
+ Set oRange =
_Offset(poRange, 0, lLower, 0, lUpper - lLower + 1)
+ Else
' CELL
+ Set oRange =
_Offset(poRange, i, lLower, 1, lUpper - lLower + 1)
+ End If
+ If Not IsNull(oRange)
Then vRanges = ScriptForge.SF_Array.Append(vRanges, oRange)
+ lLower = -1
: lUpper = -1
+ End If
+ Next j
+
+ Next i
+ Case Else
+ ' Should not happen
+ End Select
+
+ End With
+
+Finally:
+ _ComputeFilter = vRanges()
+ Exit Function
+End Function ' SFDocuments.SF_Calc._ComputeFilter
+
REM
-----------------------------------------------------------------------------
Public Function _ConvertFromDataArray(ByRef pvDataArray As Variant) As Variant
''' Convert a data array to a scalar, a vector or a 2D array
