Функции для работы с диапазонами как множеством ячеек

[eeigor]

Тема является продолжением моего поста здесь.
Попытался реализовать аналоги пока двух функций из списка: Intersection(), Union(), Difference(), SymmetricDifference().

Edit: Реализованы все: Difference() в ответе #34, SymmetricDifference() в ответе #35.

Примечательно то, что штатный метод диапазона (диапазонов) ячеек <queryIntersection> работает по принципу "OR", а похожий метод Application.Intersect (Excel) - по принципу "AND". Отсюда дополнительный параметр "Operator". Кстати, нужно и так, и так, но по умолчанию я сделал через "AND", как в Excel. Наименование "Intersection" соответствует имени метода в Python.

С функцией Union всё просто: метод addRangeAddresses фактически реализует эту задачу. Интерес представляют оставшиеся функции.
Работа будет продолжена. Высказывайте свои замечания. Помогайте.

Код Выделить Развернуть

Function Intersection(RangeAddress As com.sun.star.table.CellRangeAddress _
, RangeAddresses() As com.sun.star.table.CellRangeAddress, Optional Operator%) As Object
''' Intersect other cell ranges (or a range) with the specified cell range.
''' Arguments:
''' RangeAddress: The specified cell range (its address).
''' RangeAddresses():
''' A sequence of other cell ranges (their addresses) to intersect with the specified range.
''' Operator (optional, defualt is 0):
''' 0 means "AND" (all other ranges intersect the specified range at the same time):
''' range & other & ...
''' 1 means "OR" (at least one other range intersects the specified range):
''' range & (other | ...)
''' ' NOTE: Any number other than 0 will be evaluated as 1.
''' Returns new range(s) as com.sun.star.sheet.XSheetCellRanges with elements
''' common to the specified range and all (if Operator = 0) or any (if Operator = 1) of the others.
''' Remarks:
''' Application.Intersect method (Excel)
''' ☛ https://docs.microsoft.com/en-us/office/vba/api/excel.application.intersect
''' Returns a Range object that represents the rectangular intersection of two or more ranges.
''' If one or more ranges from a different worksheet are specified, an error is returned.

On Local Error GoTo HandleErrors
Dim oRanges As Object, oRange As Object
Dim i%, nSheet&  'sheet index

nSheet = RangeAddress.Sheet
For i = 0 To UBound(RangeAddresses)
If RangeAddresses(i).Sheet <> nSheet Then
MsgBox "One or more cell ranges from a different sheet are specified." & Chr(10) _
& Chr(10) & "For example, """ & ThisComponent.Sheets(nSheet).Name & """" _
& " and """ & ThisComponent.Sheets(RangeAddresses(i).Sheet).Name & """." _
, MB_ICONEXCLAMATION, "Invalid Parameter"
Exit Function
End If
Next

If IsMissing(Operator) Then Operator = 0 Else Operator = Abs(CBool(Operator))

If Operator Then
oRanges = ThisComponent.createInstance("com.sun.star.sheet.SheetCellRanges")
oRanges.addRangeAddresses(RangeAddresses(), False)  'bMergeRanges:=False
oRanges = oRanges.queryIntersection(RangeAddress)
Else
With RangeAddress
oRange = ThisComponent.Sheets _
.getCellRangeByPosition(.StartColumn, .StartRow, .EndColumn, .EndRow, .Sheet)
End With
For i = 0 To UBound(RangeAddresses)
oRanges = oRange.queryIntersection(RangeAddresses(i))
If oRanges.Count Then
oRange = oRanges(0)
Else: Exit For
End If
Next
End If

Intersection = IIf(oRanges.Count, oRanges, Nothing)
Exit Function

HandleErrors:
Msgbox "Error " & Err & " at line " & Erl & ": " & Error _
, MB_ICONSTOP, "macro:Intersection()"
End Function

Updated: Intersection = IIf(oRanges.Count, oRanges, Nothing)


Примечание. В качестве второго аргумента можно передавать массив адресов диапазонов, но в пределах одного листа:
 Array(oRange1.RangeAddress, ...)  или  oRanges.RangeAddresses

Edit 1:
Если Operator = 0 (AND) по умолчанию, то будет возвращен объект oRanges (com.sun.star.sheet.XSheetCellRanges), включающий один прямоугольный диапазон, или Nothing.
Если Operator = 1 (OR), то может быть возвращено несколько диапазонов, входящих в состав указанного (первый аргумент функции) независимо от других, или Nothing.

Код Выделить Развернуть

Sub Test_Intersection()
Dim oRange1 As Object, oRange2 As Object, oRange3 As Object

With ThisComponent.CurrentController.ActiveSheet
oRange1 = .getCellRangeByName("B3:F25")  'F3:F25
oRange2 = .getCellRangeByName("B4:G4")
oRange3 = .getCellRangeByName("C3:C11")
End With

Dim i%, s$
For i = 0 To 1  'operator
oRanges = oRange1.queryEmptyCells()
oRanges.addRangeAddresses(Array(oRange2.RangeAddress, oRange3.RangeAddress), False)
oRanges = Intersection(oRange1.RangeAddress, oRanges.RangeAddresses, i)
s = "Operator = " & i & Chr(10) & Chr(10)
If IsNull(oRanges) Then
MsgBox "Ranges don't intersect."
Else
ThisComponent.CurrentController.select(oRanges)
s = s & ThisComponent.CurrentSelection.AbsoluteName  'semicolon-separated
s = Join(Split(s, ";"), Chr(10))
MsgBox s, Title:="Test_Intersection"
End If
Next
End Sub


Edit 2:
Файл для тестирования приложен.

[eeigor]

С функцией Union всё просто: метод addRangeAddresses фактически реализует эту задачу.

Union()
Код легкий. Просто удобная обёртка. Тут важнее перебор ячеек в объединенных "разнокалиберных" диапазонах.

Код Выделить Развернуть

Function Union(RangeAddress As com.sun.star.table.CellRangeAddress _
, RangeAddresses() As com.sun.star.table.CellRangeAddress) As Object
'''
''' Arguments:
''' RangeAddress: The specified cell range (its address).
''' RangeAddresses:
''' A sequence of addresses of all ranges to be united.
''' range | other | ...
''' Return a new range with elements from the range and all others.
''' Remarks:
''' Application.Union method (Excel)
''' ☛ https://docs.microsoft.com/en-us/office/vba/api/excel.application.union
''' Returns the union of two or more ranges.

On Local Error GoTo HandleErrors
Dim oRanges As Object
oRanges = ThisComponent.createInstance("com.sun.star.sheet.SheetCellRanges")
oRanges.addRangeAddress(RangeAddress, False)
oRanges.addRangeAddresses(RangeAddresses(), True)  'bMergeRanges:=True

Union = IIf(oRanges.Count, oRanges, Nothing)
Exit Function

HandleErrors:
Msgbox "Error " & Err & " at line " & Erl & ": " & Error _
, MB_ICONSTOP, "macro:Union()"
End Function


2 вопроса:
1. Объединяется всё верно, но вот при переборе часть ячеек теряется. Например, ниже в перечисление не попадают ячейки: B4, C4 (см. скриншот). Почему? — Потому что пустые.
Но диапазоны с этими ячейками присутствуют.
2. При объединении диапазонов полного слияния не происходит, если хотя бы одна ячейка не входит в состав другого диапазона. Появляются дубликаты ячеек в перекрывающихся поддиапазонах. Например, ячейка F4. Однако при перечислении никаких дублей нет. Впрочем, это хорошо (не наша забота).

Код Выделить Развернуть

Sub Test_Union()
Dim oRanges As Object, oRange1 As Object, oRange2 As Object, oRange3 As Object

With ThisComponent.CurrentController.ActiveSheet
oRange1 = .getCellRangeByName("F3:F5")
oRange2 = .getCellRangeByName("B4:G4")
oRange3 = .getCellRangeByName("C3:C4")
End With

oRanges = Union(oRange1.RangeAddress, Array(oRange2.RangeAddress, oRange3.RangeAddress))

Dim oCell As Object
Dim s$
s = oRanges.AbsoluteName & Chr(10)
For Each oCell In oRanges.Cells
s = s & Chr(10) & oCell.AbsoluteName
Next
MsgBox s, Title:="Test_Union"

Dim oEnum As Object
oEnum = oRanges.Cells.createEnumeration()
s = oRanges.AbsoluteName & Chr(10)
Do While oEnum.hasMoreElements()
oCell = oEnum.nextElement()
s = s & Chr(10) & oCell.AbsoluteName
Loop
MsgBox s, Title:="Test_Union"
End Sub

Оба способа перебора дают одинаково неполный результат (без дубликатов).

[economist]

важнее перебор ячеек в объединенных "разнокалиберных" диапазонах.

Тоже терял "угловые" или ячейки в своих макросах в прямоугольных, но разных диапазонах. В какой-то момент перешел на анализ текстовых дескрипторов диапазонов:

Код Выделить Развернуть


adr = ThisComponent.getCurrentSelection(0).RowDescriptions
row_start = cdbl(split(adr(s), " ")(1))-1

Костыльно, но кмк работает надежнее.

[mikekaganski]

Оба способа перебора дают одинаково неполный результат (без дубликатов).

Это один и тот же способ (For Each - это syntactic sugar для createEnumeration + nextElement).
И это, возможно, баг. Связан с перечислением только непустых ячеек. Пожалуйста, напишите.
А может быть, и нет.
DevGuide говорит:

• The method getCells() returns the interface com.sun.star.container.XEnumerationAccess of a cell collection. The service com.sun.star.sheet.Cells is discussed below. This collection contains the cell addresses of non-empty cells in all cell ranges.

Да и сам сервис документирован как

collection of used cells in a spreadsheet document

Правда, возникает естественный вопрос - как тогда обращаться к незаполненным ячейкам диапазонов. Но, видимо, это тема для enhancement request.

[mikekaganski]

Код Выделить Развернуть

If IsMissing(Operator) Then Operator = 0 Else Operator = Abs(CBool(Operator))

А для чего Abs?

[eeigor]

Можно опустить, поскольку я сравниваю
If Operator Then

[sokol92]

как тогда обращаться к незаполненным ячейкам диапазонов

Для этого можно использовать queryEmptyCells.

Что касается общей задачи, то объединение и пересечение по смыслу (теоретико-множественному) этих терминов предполагает, что каждая ячейка будет входить в результат не более одного раза. В Excel, кстати, с этим большие проблемы. В LO для достижения этой цели предусмотрен параметр bMergeRanges. Стресс-тестирование еще не проводил.

В макросах общего назначения для получения объединения и пересечения диапазонов (входные) параметры лучше сделать типа Variant, поскольку это даст возможность передавать объекты, поддерживающие сервисы SheetCellRange, SheetCellRanges и другие (например, TableRow, TableRows, ...).

Объекты, поддерживающие сервис SheetCellRanges, не имеют аналога в Excel, поскольку их ячейки могут находиться на разных листах документа. Это - преимущество, от которого не надо отказываться.

[mikekaganski]

как тогда обращаться к незаполненным ячейкам диапазонов

Для этого можно использовать queryEmptyCells.

К сожалению, это не решает задачи итерации по ячейкам

[sokol92]

Да, для прогулок по ячейкам не помешал бы интерфейс XEnumerationAccess в SheetCellRange.

[mikekaganski]

Что касается общей задачи, то объединение и пересечение по смыслу (теоретико-множественному) этих терминов предполагает, что каждая ячейка будет входить в результат не более одного раза.

Обратите внимание, что эта задача не эквивалентна "создать набор непересекающихся диапазонов", поскольку диапазон - это не ячейка. Если проводить параллели с теорией, то "A ∪ B" является валидным обозначением объединения, даже если A и B имеют пересекающиеся диапазоны. И при анализе этого объединения можно продолжать рассматривать отдельно A и B (и их свойства) как отдельные сущности (а можно выделять A - (A ∩ B), в зависимости от задачи).

Тем более что задачей сервиса не является решение теоретических проблем - главное, чтобы он решал практические задачи. Вот итерация по ячейкам - это процедура, которая должна отвечать теоретико-множественному определению
А итерация по диапазонам - вопрос.

[eeigor]

В LO для достижения этой цели предусмотрен параметр bMergeRanges. Стресс-тестирование еще не проводил.

Слияние возможно, если один диапазон полностью входит (fit) в другой, а если хотя бы одна ячейка "вылезет" за габариты, то и те ячейки, что вошли в габариты, не будут слиты (merged), диапазон такой останется нетронутым. Короче, bMergeRanges помогает не до конца.
Edit:
Точнее, он сливает именно диапазоны, не дробя их на ячейки.

В макросах общего назначения для получения объединения и пересечения диапазонов (входные) параметры лучше сделать типа Variant, поскольку это даст возможность передавать объекты, поддерживающие сервисы SheetCellRange, SheetCellRanges и другие (например, TableRow, TableRows, ...).

По этой причине я оставил аргументы функций как CellRangeAddress. Проглотит и строку/столбец, и целый лист.

[eeigor]

Всё-таки какой-то способ перечисления ячеек надо найти. И иметь возможность пустым ячейкам присваивать значение. Иначе и в объединении диапазонов пропадает смысл.

Вспомнилось по теме...

[eeigor]

collection of used cells in a spreadsheet document

"Cells Service Reference represents a collection of used cells in a spreadsheet document".
Однако, used cells здесь трактуется иначе, чем UsedArea:
 oCursor.gotoStartOfUsedArea(False)  'bExpand:=False
 oCursor.gotoEndOfUsedArea(True)

На мой взгляд, правильно, когда любая ячейка в пределах используемого диапазона является используемой. Иначе и возникает этот нонсенс: в пределах используемой "площади" (area) могут быть неиспользуемые ячейки. Чем руководствовались разработчики метода getCells() неясно. Понятия "используемый" (used) и "непустой" (non-empty) или, наоборот, неиспользуемый и пустой должны быть разведены.
А метод queryEmptyCells() решает конкретную задачу. Стало быть, получив пустые ячейки, мы можем их посчитать. А можем ли мы по ним пройтись?! Если да, то каким способом. А иначе зачем они нам нужны?

Edit:
Выводы:
1. Всякая ячейка в пределах используемой площади (used area) является (должна быть) используемой.
2. Используемая ячейка может быть пустой (used but empty).

Одним из способов решения проблемы будет создание словаря (map) ячеек из исходных диапазонов с ключом String oCell.AbsoluteName и значением Any oCell.CellAddress.

Тогда простая функция Union перестаёт быть такой уж тривиальной.
Что она должна вернуть? Возможно, массив уникальных адресов ячеек: CellAddresses(). По нему уже можно "гулять". Естественно, не очень эффективный подход из-за цикла при заполнении массива.

[eeigor]

Простой категорический силлогизм:
1. Все ячейки of used area are used. 2. Ячейка X входит в used area. Следовательно, ячейка X is used.
Шутка

[mikekaganski]

1. Всё ячейки of used area are used.

Парадокс импликации в действии.