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

[mikekaganski]

Не в порядке критики, а так, в порядке размышлений, скажу следующее. Непросто найти компромисс между универсальностью применения функции и сложностью её реализации. Вы придерживаетесь первого (функция принимает аргумент в любом виде), а я напротив: более явно определяю параметры функции и облегчаю реализацию. Вы "помогаете" пользователю, а я "дисциплинирую" его.

Лучше всего дисциплинирует пользователя уничтожение поддержки всех языков написания макросов, кроме ассемблера.

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

[eeigor]

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

А что касается универсальности, то метод addRangeAddress мог бы и принять CellAddress, как, к примеру, сервис SheetCellRange поддерживает SheetCell (пишу по памяти). Но пошли другим путём: добавили к ячейке свойство RangeAddress. О чём узнал только сегодня, ибо не логично, но понятно зачем.

[sokol92]

метод addRangeAddress мог бы и принять CellAddress

В методах UNO, если типом параметра указана структура, то никаких "вольностей" не допускается.

Сервис SheetCell не включает себя сервис SheetCellRange и наоборот.

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

Sub Test
  Dim oCell, oCell2
  With ThisComponent.Sheets(0)
    oCell=.getCellByPosition(0, 0)
    oCell2=.getCellRangeByPosition(0, 0, 0, 0)
  End With
End Sub

В приведенном выше макросе переменная oCell будет содержать ссылку на объект, который, в частности, поддерживает сервисы SheetCell и SheetCellRange.
Переменная oCell2 будет содержать ссылку на объект, который, в частности, поддерживает SheetCellRange и не поддерживает SheetCell.

[eeigor]

Владимир, спасибо

[eeigor]

Если оперировать поячеечно, то несложно выполнить любую операцию с множествами ячеек. Но в функциях Intersect и Union были задействованы штатные возможности.
В коде ниже при вычитании (Difference) использована функция GetCellCollection.
В качестве ключа элемента коллекции ячеек задано имя ячейки AbsoluteName. По ключу и удаляем (вычитаем) ненужные ячейки.
В примере от @sokol92 использован словарь (Map) с ключом в виде отформатированной комбинации свойств (индексы листа, столбца, строки...). Сделано это для решения проблемы сортировки ячеек при их помещении (put) в словарь. Таким образом, если использовать этот подход, то и ключ будет соответствующим при удалении ячейки из словаря.
Работать с VBA Collection проще, но возникла проблема с сортировкой ячеек перед их добавлении в коллекцию. В ответе #21 приведен пример сортировки, если бы это был не Basic, а Python. В ответе #22 показан способ сортировки через выделение на листе, но он имеет баг при выделении диапазонов, расположенных на нескольких листах (возможный, но менее вероятный случай).
Впрочем, несложно реализовать функцию AddToSortedCollection
 Function AddToSortedCollection(col As Collection, vNewItem, Optional sKey$) As Boolean
которая добавит новый элемент на правильное место (метод Add имеет параметр, определяющий место вставки i: col.Add vNewItem, sKey, i)
Тогда для правильной сортировки придется изменить ключ (подход от @sokol92), отформатировав строку исходя из:
Each spreadsheet can have up to 10 000 sheets, and each sheet can have a maximum of 1 048 576 rows and a maximum of 1 024 columns.

Difference()

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

Function Difference(RangeAddress As com.sun.star.table.CellRangeAddress _
, RangeAddresses() As com.sun.star.table.CellRangeAddress) As Object
''' Subtract other cell ranges (or a range) from the specified cell range.
''' Argument:
''' RangeAddress: The specified cell range (its address).
''' RangeAddresses():
''' A sequence of other cell ranges (their addresses)
''' to be subtracted (excluded) from the specified range.
''' Return a new range with elements in the range that are not in the others.
''' range - other - ...  '(S = A \ B)

On Local Error GoTo HandleErrors
Dim oRanges As Object, oCell As Object
Dim A As New Collection, B As New Collection

A = GetCellCollection(Array(RangeAddress))
B = GetCellCollection(RangeAddresses())

On Local Error Resume Next
For Each oCell In B
A.Remove oCell.AbsoluteName
Next
On Local Error GoTo HandleErrors

oRanges = ThisComponent.createInstance("com.sun.star.sheet.SheetCellRanges")
For Each oCell In A
oRanges.addRangeAddress(oCell.RangeAddress, True)
Next

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

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

Sub Test_Difference()
Dim oRanges As Object, oRange1 As Object, oRange2 As Object

With ThisComponent.CurrentController.ActiveSheet
oRange1 = .getCellRangeByName("B3:F25")
oRange2 = .getCellRangeByName("B4:G4")
End With

oRanges = Difference(oRange1.RangeAddress, Array(oRange2.RangeAddress))
MsgBox oRanges.AbsoluteName
End Sub

[eeigor]

SymmetricDifference()

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

Function SymmetricDifference(RangeAddress As com.sun.star.table.CellRangeAddress _
, RangeAddress2 As com.sun.star.table.CellRangeAddress) As Object
''' Substract a cell range that is in both passed ranges, but not at their intersection (disjunctive union).
''' Arguments:
''' RangeAddress: The specified cell range address.
''' RangeAddress2: The other cell range address.
''' range ^ other  'S = A Δ B = (A ∪ B) \ (A ∩ B) = (A \ B) ∪ (B \ A)
''' Return new range(s) as com.sun.star.sheet.XSheetCellRanges with elements
''' either in the specified range or in the other range, but not both.

On Local Error GoTo HandleErrors
Dim oRanges As Object
oRanges = Difference(RangeAddress, Array(RangeAddress2))
oRanges.addRangeAddresses(Difference(RangeAddress2, Array(RangeAddress)).RangeAddresses, True)

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

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

Sub Test_SymmetricDifference()
Dim oRanges As Object, oRange1 As Object, oRange2 As Object

With ThisComponent.CurrentController.ActiveSheet
oRange1 = .getCellRangeByName("B3:F25")
oRange2 = .getCellRangeByName("B4:G4")
End With

oRanges = SymmetricDifference(oRange1.RangeAddress, oRange2.RangeAddress)
MsgBox oRanges.AbsoluteName
End Sub

[eeigor]

InvertSelection()

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

Sub InvertSelection(oTarget As Object)
''' Invert the current selection that intersects the target range.
''' Argument:
''' oTarget: One cell or cell range(s).

On Local Error GoTo HandleErrors
Dim oSelection As Object, oRanges As Object, oRange As Object

oSelection = ThisComponent.CurrentSelection
If oSelection.supportsService("com.sun.star.sheet.SheetCellRanges") Then
oRanges = oSelection
oRanges = Difference(oTarget.RangeAddress, oRanges.RangeAddresses)
ElseIf oSelection.supportsService("com.sun.star.sheet.SheetCellRange") Then
oRange = oSelection
oRanges = Difference(oTarget.RangeAddress, Array(oRange.RangeAddress))
Else
MsgBox "No single cell or range(s) selected." _
, MB_ICONEXCLAMATION, "Selection Error"
Exit Sub
End If

ThisComponent.CurrentController.select(oRanges)
Exit Sub

HandleErrors:
Msgbox "Error " & Err & " at line " & Erl & ": " & Error _
, MB_ICONSTOP, "macro:InvertSelection"
End Sub

Sub Test_InvertSelection()
Dim oRanges As Object, oRange As Object

With ThisComponent.CurrentController.ActiveSheet
oRange = .getCellRangeByName("B3:F25")
End With
oRanges = oRange.queryEmptyCells()
ThisComponent.CurrentController.select(oRanges)
MsgBox "Before:" & Chr(10) & ThisComponent.CurrentSelection.AbsoluteName
Call InvertSelection(oRange)
MsgBox "After:" & Chr(10) & ThisComponent.CurrentSelection.AbsoluteName
End Sub

Но тут требуется решить, как быть с текущей ячейкой в пределах целевого диапазона: считать её выделением или нет?
Edit:
Как отличить активную ячейку от выделенной (цветом)?

[eeigor]

Вопрос решён в основном. За мной один баг с "задвоением" расположенных на разных листах диапазонов при их выделении (ответ #23).
Требуется окончательно решить, какой метод получения ячеек использовать: VBA Collection vs EnumerableMap. Именно вспомогательная функция GetCellCollection и стала основной в этом "инструментальном" наборе.

Повторю: тема была направлена на решение конкретной задачи.


Edit:
Возможно, будут какие-то замечания/предложения по этому набору (прежде всего, в части сигнатуры процедур). Высказывайтесь... Работа проводилась с заделом на будущее.

[eeigor]

За мной один баг с "задвоением" расположенных на разных листах диапазонов при их выделении (ответ #23).

Bug report

[kompilainenn]

Bug report

проблема в работе макроса или в работе самого Calc?

[eeigor]

Проблема в методе select при выделении ячеек, расположенных на нескольких (зд. двух) листах. Ячейки первого листа выделяются в том числе и на втором, а ячейка второго листа в примере (файл приложен) выделяется в том числе и на первом листе. В результате количество ячеек удваиваится.