wizards/source/sfdocuments/SF_Calc.xba | 97 +++++++++++++++++++++------------
1 file changed, 62 insertions(+), 35 deletions(-)
New commits:
commit 40bc1b275324f9a730960fe5d4d8982cdfbc7b03
Author: Jean-Pierre Ledure <j...@ledure.be>
AuthorDate: Tue Jan 17 18:13:48 2023 +0100
Commit: Jean-Pierre Ledure <j...@ledure.be>
CommitDate: Wed Jan 18 14:18:40 2023 +0000
ScriptForge - (SF_Calc) sort ranges on more than 3 keys
The Calc.SortRange() method sorts
the given range on any number of columns/rows.
The sorting order may vary by column/row.
The sorting algorithm allows for maximum 3 keys.
When the number of sort keys is > 3 then the range
is sorted several times, by groups of 3 keys,
starting from the last key.
In this context the algorithm used by Calc
to sort ranges is presumed STABLE,
i.e. it maintains the relative order of records
with equal keys.
Change-Id: If7f4920f7ab8f8ffb71edf648ed9accc8eb62dce
Reviewed-on: https://gerrit.libreoffice.org/c/core/+/145681
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 391321f361d8..f2c9fc34e2f2 100644
--- a/wizards/source/sfdocuments/SF_Calc.xba
+++ b/wizards/source/sfdocuments/SF_Calc.xba
@@ -1084,7 +1084,7 @@ Const cstSubArgs = "SourceRange,
DestinationRange"
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
sCopy = ""
-Check:
+Check:string
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
If Not _IsStillAlive(True) Then GoTo Finally
If Not ScriptForge.SF_Utils._Validate(SourceRange,
"SourceRange", Array(V_STRING, ScriptForge.V_OBJECT), , ,
CALCREFERENCE) Then GoTo Finally
@@ -3305,7 +3305,11 @@ Public Function SortRange(Optional ByVal Range As
Variant _
, Optional
ByVal CaseSensitive As Variant _
, Optional
ByVal SortColumns As Variant _
) As Variant
-''' Sort the given range on maximum 3 columns/rows. The
sorting order may vary by column/row
+''' Sort the given range on any number of columns/rows. The
sorting order may vary by column/row
+''' If the number of sort keys is > 3 then the range is
sorted several times, by groups of 3 keys,
+''' starting from the last key. In this context the
algorithm used by Calc to sort ranges
+''' is presumed STABLE, i.e. it maintains the relative
order of records with equal keys.
+'''
''' Args:
''' Range: the range to sort as a string
''' SortKeys: a scalar (if 1 column/row) or an
array of column/row numbers starting from 1
@@ -3329,13 +3333,19 @@ Public Function SortRange(Optional ByVal Range As
Variant _
Dim sSort As String ' Return value
Dim oRangeAddress As _Address ' Parsed range
Dim oRange As Object '
com.sun.star.table.XCellRange
+Dim oSortRange As Object ' The area to sort as an
_Address object
Dim oDestRange As Object ' Destination as a range
Dim oDestAddress As Object '
com.sun.star.table.CellRangeAddress
Dim oDestCell As Object '
com.sun.star.table.CellAddress
Dim vSortDescriptor As Variant ' Array of
com.sun.star.beans.PropertyValue
Dim vSortFields As Variant ' Array of
com.sun.star.table.TableSortField
Dim sOrder As String ' Item in SortOrder
-Dim i As Long
+Dim lSort As Long ' Counter for
sub-sorts
+Dim lKeys As Long ' UBound of
SortKeys
+Dim lKey As Long ' Actual index in
SortKeys
+Dim i As Long, j As Long
+Const cstMaxKeys = 3 ' Maximum number of keys
allowed in a single sorting step
+
Const cstThisSub = "SFDocuments.Calc.SortRange"
Const cstSubArgs = "Range, SortKeys,
[TargetRange=""""],
[SortOrder=""ASC""],
[DestinationCell=""""], [ContainsHeader=False],
[CaseSensitive=False], [SortColumns=False]"
@@ -3368,47 +3378,64 @@ Check:
If Not ScriptForge.SF_Utils._Validate(SortColumns,
"SortColumns", ScriptForge.V_BOOLEAN) Then GoTo Finally
End If
Set oRangeAddress = _ParseAddress(Range)
- If Len(DestinationCell) > 0 Then Set oDestRange =
_ParseAddress(DestinationCell)
+ If Len(DestinationCell) > 0 Then Set oDestRange =
_ParseAddress(DestinationCell) Else Set oDestRange = Nothing
Try:
- ' Initialize the sort descriptor
+ ' Initialize a generic sort descriptor
Set oRange = oRangeAddress.XCellRange
- vSortDescriptor = oRange.createSortDescriptor
+ vSortDescriptor = oRange.createSortDescriptor ' Makes a generic
sort descriptor for ranges
vSortDescriptor =
ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor,
"IsSortColumns", SortColumns)
vSortDescriptor =
ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor,
"ContainsHeader", ContainsHeader)
vSortDescriptor =
ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor,
"BindFormatsToContent", True)
- If Len(DestinationCell) = 0 Then
- vSortDescriptor =
ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor,
"CopyOutputData", False)
- Else
- Set oDestAddress = oDestRange.XCellRange.RangeAddress
- Set oDestCell = New com.sun.star.table.CellAddress
- With oDestAddress
- oDestCell.Sheet = .Sheet
- oDestCell.Column = .StartColumn
- oDestCell.Row = .StartRow
- End With
- vSortDescriptor =
ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor,
"CopyOutputData", True)
- vSortDescriptor =
ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor,
"OutputPosition", oDestCell)
- End If
vSortDescriptor =
ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor,
"IsUserListEnabled", False)
- ' Define the sorting keys
- vSortFields = Array()
- ReDim vSortFields(0 To UBound(SortKeys))
- For i = 0 To UBound(SortKeys)
- vSortFields(i) = New com.sun.star.table.TableSortField
- If i > UBound(SortOrder) Then sOrder = "" Else
sOrder = SortOrder(i)
- If Len(sOrder) = 0 Then sOrder = "ASC"
- With vSortFields(i)
- .Field = SortKeys(i) - 1
- .IsAscending = ( UCase(sOrder) = "ASC" )
- .IsCaseSensitive = CaseSensitive
- End With
- Next i
+ ' Sort by keys group
+ ' If keys = (1, 2, 3, 4, 5) then groups = (4, 5), (1, 2, 3)
+ lKeys = UBound(SortKeys)
+ lSort = Int(lKeys / cstMaxKeys)
+ Set oSortRange = oRangeAddress
+
+ For j = lSort To 0 Step -1 ' Sort first on last sort
keys
+
+ ' The 1st sort must consider the destination area. Next
sorts are done on the destination area
+ If Len(DestinationCell) = 0 Or j < lSort Then
+ vSortDescriptor =
ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor,
"CopyOutputData", False)
+ vSortDescriptor =
ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor,
"OutputPosition", Nothing)
+ Else
+ Set oDestAddress = oDestRange.XCellRange.RangeAddress
+ Set oDestCell = New com.sun.star.table.CellAddress
+ With oDestAddress
+ oDestCell.Sheet = .Sheet
+ oDestCell.Column = .StartColumn
+ oDestCell.Row = .StartRow
+ End With
+ vSortDescriptor =
ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor,
"CopyOutputData", True)
+ vSortDescriptor =
ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor,
"OutputPosition", oDestCell)
+ End If
+
+ ' Define the sorting keys
+ vSortFields = DimArray(lKeys Mod cstMaxKeys)
+ For i = 0 To UBound(vSortFields)
+ vSortFields(i) = New com.sun.star.table.TableSortField
+ lKey = j * cstMaxKeys + i
+ If lKey > UBound(SortOrder) Then sOrder =
"" Else sOrder = SortOrder(lKey)
+ If Len(sOrder) = 0 Then sOrder = "ASC"
+ With vSortFields(i)
+ .Field = SortKeys(lKey) - 1
+ .IsAscending = ( UCase(sOrder) =
"ASC" )
+ .IsCaseSensitive = CaseSensitive
+ End With
+ Next i
+ lKeys = lKeys - UBound(vSortFields) - 1
+
+ ' Associate the keys and the descriptor, and sort
+ vSortDescriptor =
ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "SortFields",
vSortFields)
+ oSortRange.XCellRange.sort(vSortDescriptor)
+
+ ' Next loop, if any, is done on the destination area
+ If Len(DestinationCell) > 0 And j = lSort And lSort > 0
Then Set oSortRange = _Offset(oDestRange, 0, 0, oRangeAddress.Height,
oRangeAddress.Width)
- ' Associate the keys and the descriptor, and sort
- vSortDescriptor =
ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "SortFields",
vSortFields)
- oRange.sort(vSortDescriptor)
+ Next j
' Compute the changed area
If Len(DestinationCell) = 0 Then
