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

[eeigor]

Михаил, день добрый!
Но ведь это не так легко исправить. Проще реализовать функцию Union, которая, к примеру, объединит пустые ячейки, полученные методом queryEmptyCells, и предоставит возможность перебрать их. Тот способ от @sokol92 с использованием метода fillAuto был трюковым (для заполнения пустых ячеек).

[mikekaganski]

В принципе достаточно создать сервис AllCellsEnumeration, который тоже будет реализовывать XEnumeration, но только будет проходить по всем ячейкам, а не только по используемым, и получать его либо из нового метода Cells Service, либо из нового метода CellsEnumeration Service.

Что-то вроде

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

For Each oCell In oRanges.CellsIncludingEmpty

или

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

For Each oCell In oRanges.Cells.AllCells

[eeigor]

А если к методу getCells добавить необязательный аргумент nCellType, default is 0 (EmptyCells), чтобы не поломать текущую реализацию, 1 – AllCells и что-то ещё из области SpecialCells (Excel)? Хотя всё уже, вроде, реализовано, кроме LastCell, SameValidation...

getCells(Optional nCellType&)

[sokol92]

Что-то вроде

Голосую за

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

For Each oCell In oRanges.AllCells

и

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

For Each oCell In oRange.AllCells

[mikekaganski]

А если к методу getCells добавить

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

С другой стороны, может быть, не AllCells, а EmptyCells? тогда Cells + EmptyCells - это полный набор, и можно индивидуально использовать то или другое.

В любом случае - нужен баг до того, как что-то реализовывать.

[eeigor]

GetCellCollection()
Привожу вариант как перебрать все ячейки, включая пустые, пока не появится "встроенное" решение.
Примечание. Ограничение на принадлежность всех диапазонов к одному листу можно убрать (@sokol92 считает это преимуществом перед Excel):
   For n = 1 To UBound(RangeAddresses).
Как недостатки можно отметить: 1) диапазоны разбиваются на ячейки, а коллекция ячеек заполняется в цикле; 2) ячейки располагаются в порядке следования диапазонов, а не в порядке их расположения на листе.

Но через это "горлышко" придётся пропускать все полученные результаты операций с множествами диапазонов, если они содержат пустые ячейки, которые нам нужны.

Вопрос: Есть предложения, как эффективно выделить прямоугольные диапазоны из множества ячеек и вернуть объект CellRanges вместо VBA Collection? Это было бы более последовательно: все другие методы возвращают именно диапазоны ячеек, и использовать "чужой" объект тоже не хочется (хотя и вполне работоспособный).

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

Function GetCellCollection(RangeAddresses() As com.sun.star.table.CellRangeAddress) As Object
''' Returns a VBA collection of all unique cells, including empty cells.

On Local Error GoTo HandleErrors
Dim oRanges As Object, oRange As Object, oCell As Object
Dim Cells As New Collection  'CellCollection
Dim n&, nSheet&  'sheet index
Dim i&, j&  'row and column indices of each range

If IsArray(RangeAddresses) And UBound(RangeAddresses) = -1 Then Exit Function

nSheet = RangeAddresses(0).Sheet
For n = 1 To UBound(RangeAddresses)
If RangeAddresses(n).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(n).Sheet).Name & """." _
, MB_ICONEXCLAMATION, "Invalid Parameter"
Exit Function
End If
Next

oRanges = ThisComponent.createInstance("com.sun.star.sheet.SheetCellRanges")
oRanges.addRangeAddresses(RangeAddresses(), True)  'bMergeRanges:=True
For Each oRange In oRanges
For j = 0 To oRange.Columns.Count - 1
For i = 0 To oRange.Rows.Count - 1
oCell = oRange.getCellByPosition(j, i)
Cells.Add oCell, oCell.AbsoluteName  'error occurs if key is used
Next i
Next j
Next oRange

GetCellCollection = IIf(Cells.Count, Cells, Nothing)
Exit Function

HandleErrors:
' NOTE: This is the only likely error.
If Err = 5 Then  'Invalid procedure call: key is probably being used.
Resume Next
Else
Msgbox "Error " & Err & " at line " & Erl & ": " & Error _
, MB_ICONSTOP, "macro:GetCellCollection()"
End If
End Function

Sub Test_GetCellCollection()
Dim oSheet As Object, oRanges As Object, oRange As Object, oCell As Object
Rem Dim Cells As New Collection  'CellCollection
Dim Cells As Object: Cells = New Collection

oSheet =  ThisComponent.CurrentController.ActiveSheet
oRange = oSheet.getCellRangeByName("B3:F25")
oRanges = oRange.queryEmptyCells()
Cells = GetCellCollection(oRanges.RangeAddresses())

If IsNull(Cells) Then
MsgBox "No cells found.", Title:="Test_GetCellCollection"
Else
Dim s$
s = "Cell Count:  " & Cells.Count & Chr(10)
For Each oCell In Cells
s = s & Chr(10) & oCell.AbsoluteName
Next
MsgBox s, Title:="Test_GetCellCollection"
End If
End Sub

Code updated

Тест выше извлекает пустые ячейки и перебирает их. Файл с примером данных (но без этих процедур) приложен к стартовому сообщению.

Edit:
Впереди будет ещё одна задача: InvertSelection()

[eeigor]

2) ячейки располагаются в порядке следования диапазонов, а не в порядке их расположения на листе.

Попытался отсортировать диапазоны по столбцу и строке одновременно (by upper-left cell) в Python.
Просто однако. Но как это сделать в Basic?

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

from collections import namedtuple
from operator import itemgetter, attrgetter

RangeAddress = namedtuple('RangeAddress', 'Sheet StartColumn StartRow EndColumn EndRow')
addr0 = RangeAddress(Sheet=0, StartColumn=1, StartRow=3, EndColumn=2, EndRow=6)
addr1 = RangeAddress(0, 3, 3, 3, 5)
addr2 = RangeAddress(0, 4, 4, 4, 4)
addr3 = RangeAddress(0, 4, 21, 4, 21)
addr4 = RangeAddress(0, 5, 19, 5, 19)
addr5 = RangeAddress(0, 5, 24, 5, 24)

RangeAddresses = [addr0, addr1, addr2, addr3, addr4, addr5]
# RangeAddresses_sorted = sorted(RangeAddresses, key=lambda addr: addr.StartColumn)
# RangeAddresses_sorted = sorted(RangeAddresses, key=lambda addr: addr.StartRow)  # breaks the sorting by column

RangeAddresses_sorted = sorted(RangeAddresses, key=itemgetter(1, 2))
print(RangeAddresses_sorted)
# It's easier to read.
RangeAddresses_sorted = sorted(RangeAddresses, key=attrgetter('StartColumn', 'StartRow'))
print(RangeAddresses_sorted)



Регистр символов (стиль) наименований LO-свойств был сохранён.

[eeigor]

2) ячейки располагаются в порядке следования диапазонов, а не в порядке их расположения на листе.

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

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


oRanges.addRangeAddresses(RangeAddresses(), True)  'bMergeRanges:=True
With ThisComponent
.CurrentController.select(oRanges)
oRanges.removeRangeAddresses(oRanges.RangeAddresses)
With .CurrentSelection
If .supportsService("com.sun.star.sheet.SheetCellRanges") Then
oRanges.addRangeAddresses(.RangeAddresses, False)
ElseIf .supportsService("com.sun.star.sheet.SheetCellRange") Then
oRanges.addRangeAddress(.RangeAddress, False)
End If
End With
End With


Как эффективно выделить прямоугольные диапазоны из множества ячеек и вернуть объект CellRanges вместо VBA Collection?

Тут я не прав. Проблема в объекте Cells, и предложенное решение (с использованием VBA Collection) как раз её и решает. Так что всё нормально.

Edit:
Но ячейки можно перебрать непосредственно по индексам, не обращаясь к свойству Cells (getCells).

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

For Each oRange In oRanges
For j = 0 To oRange.Columns.Count - 1
For i = 0 To oRange.Rows.Count - 1
oCell = oRange.getCellByPosition(j, i)
'<...>
Next i
Next j
Next oRange

Updated

[eeigor]

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

При тестировании этой возможности замечено, что при попытке выделить и считать расположенные на разных листах диапазоны происходит "задвоение" диапазонов.

Поясню на примере. oRanges получает 2 одноячеечных диапазона с разных листов: $Sheet1.$B$4;$Sheet2.$A$1. При попытке выделить их методом ThisComponent.CurrentController.select(oRanges) и при повторном добавлении в очищенный объект oRanges получим уже задвоенный набор:
$Sheet1.$A$1;$Sheet1.$B$4;$Sheet2.$A$1;$Sheet2.$B$4
Маленькое декартово произведение.

Вот так: было 2 ячейки, а стало 4.
Использовать диапазоны с разных листов можно, но, вот, выделять их не следует*. Да и смысла в этом особого нет: при переходе на другой лист выделение будет сброшено до активной ячейки. Однако такое поведение является багом. Виноват здесь метод <select> или <addRangeAddresses>, сказать не могу. Но стоит ли его исправлять? Я не вижу в этом практической целесообразности.

Использование регулярных выражений, например, приводит к некоторым рассогласованиям в автофильтре, который сложные ситуации, в отличие от других фильтров, отобразить не в состоянии (Excel ведь по какой-то причине ограничивает использование фильтров символами подстановки). Так и здесь: возможность использования разных листов усложняет логику работы. Может, стоит от этого оказаться вообще?

_________
* Выделение используется для упорядочивания диапазонов (см. фрагмент кода в ответе #22), и на одном листе этот подход приводит к нужному результату. Если диапазоны переданы в произвольном порядке, а требуется логический порядок следования ячеек (например при их выводе на экран), то диапазоны надо упорядочить.


Edit:
Ошибку "задвоения диапазонов" выдаёт метод ThisComponent.CurrentController.select(oRanges)

Пример задвоения диапазонов на скриншоте:

[sokol92]

Можно предложить такой макрос для объединения диапазонов, которому можно "скармливать" параметры разных типов (функция RangesUnion и макрос для тестирования TestRangesUnion). В результирующем объекте диапазоны отсортированы по индексу листа, столбцу, строке.

Проблема поиска метода для исключения дублирования ячеек в результирующем объекте остается актуальной (как и для Excel).

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

' Объединение диапазонов ячеек документа.
' - oDoc документ, к которому относятся все элементы массива args.
' - args массив, задающий диапазоны ячеек.
'
' Элемент массива args может представлять собой:
' - Прямоугольный диапазон ячеек (поддерживает сервис SheetCellRange).
' - Объект, поддерживающий сервис SheetCellRanges.
' - UNO-структуру CellRangeAddress.
' - Строку, представляющую адреса диапазонов(a) через точку с запятой. Адрес может включать
'     имя листа (см. описание параметра метода getCellRangesByName интерфейса sheet.XCellRangesAccess). Если
'     имя листа опущено, то берутся адреса ячеек листа с индексом 0.
'
' Элемент массива args может быть также массивом элементов указанного выше типа.
'
' Функция возвращает объект, поддерживающий сервис SheetCellRanges. Левые верхние углы входящих в него
' диапазонов ячеек отсортированы по возрастанию номера листа документа, номера столбца, номера строки.
Function RangesUnion(ByVal oDoc, ParamArray args) As Object
 Dim arg, oRanges, oRange, oMap, oAdr, i As Long, key As String, v, oRanges2, valEnum
 oMap=com.sun.star.container.EnumerableMap.create("string", "any")  
 RangesUnion=Nothing
 
 For Each arg In args
   If Not IsArray(arg) Then arg=Array(Arg)
   For Each v In arg
     oRanges=Nothing
     If IsUnoStruct(v) Then
       oRanges=Array(v)
     ElseIf IsObject(v) Then ' объект
       If HasUnoInterfaces(v, "com.sun.star.sheet.XSheetCellRange") Then
         oRanges=oDoc.Sheets.getCellRangesByName(v.AbsoluteName)
       Else
         oRanges=v
       End If  
     ElseIf VarType(v)=V_STRING Then ' строка
       oRanges=oDoc.Sheets.getCellRangesByName(v)
     Else
       oRanges=v  
     End If
     
     If Not (oRanges Is Nothing) Then
       For Each oRange In oRanges
         If IsUnoStruct(oRange) Then
           oAdr=oRange
         Else
           oAdr=oRange.RangeAddress  
         End If  
         With oAdr
            key=Format(.Sheet, "00000") & Format(.StartColumn, "000000000") & Format(.StartRow, "000000000") & Format(i, "000000000")
         End With  
         oMap.put key, oAdr
         i=i+1
       Next oRange
     End If
   Next v
 Next arg
 
 If i>0 Then
   oRanges2=oDoc.createInstance("com.sun.star.sheet.SheetCellRanges")
   valEnum=oMap.createValueEnumeration(True)
   Do While valEnum.hasMoreElements
     oRanges2.addRangeAddress valEnum.NextElement, True      
   Loop
   RangesUnion=oRanges2
 End If
End Function


' Проверка функции RangesUnion. Предполагается, что текущий документ имеет листы "Лист2", "Лист1"
' (ярлыки листов в таком порядке) и на текущем листе (Лист1 или Лист2) выделено несколько несвязанных диапазонов.
Sub TestRangesUnion
Dim oRanges
oRanges=RangesUnion(ThisComponent, ThisComponent.CurrentSelection, _
                    ThisComponent.Sheets.getByName("Лист2").GetCellRangeByName("A2:C3").RangeAddress, _
                    ThisComponent.Sheets.getByName("Лист2").GetCellRangeByName("D2:F4"), _
                    "Лист1.A1", Array("C7:E10", "Лист1.A1:A3"))
Msgbox oRanges.AbsoluteName
End Sub



[eeigor]

Использование ParamArray требует Option Compatible.
Владимир, идея упорядочения диапазонов ясна: достигается форматирование ключа словаря (я этот подход уже видел у вас при сортировке строк без вспомогательной формулы на листе).
Диапазоны из словаря добавляются поячеечно, но при этом объединяются. А я после объединения переданных диапазонов выделял их и считывал повторно целыми блоками уже в упорядоченном виде. Однако из-за бага выделения это работало при условии, что диапазоны находятся на одном листе. У вас работает всегда.
Не совсем ясно, что будет при дублировании ключа в словаре? У меня VBA Collection такой ключ не пропустит: набор ячеек будет уникальным.
oMap.put key, oAdr  перезапишет по ключу на новое значение, если это дубликат?

Да, я предположил верно:
put():  If the map already contains a mapping for the given key, then the old value is replaced by the given new value.

Edit:
Только я сравниваю со своей функцией GetCellCollection. А при объединении диапазонов, вроде, не было проблем (ответ #1).

[sokol92]

Не совсем ясно, что будет при дублировании ключа в словаре

Ясно, спасибо за замечание. Забыл добавить счетчик при формировании ключа - исправил.

[eeigor]

Владимир, я внимательно проанализировал ваш пример, но в плане создания коллекции Cells, с возможностью перебора всех элементов, в том числе пустых ячеек. "Map" вместо VBA "Collection".
Вариант вполне рабочий. Разница только в том, с каким объектом пользователь будет  работать потом, и что для него удобнее. Единственно, на что я обратил внимание, так это вовсе необязательно работать с ячейкой как с одноячеечным диапазоном. Структура CellAddress проще, а метод addRangeAddress принимает и CellAddress наряду с RangeAddress. Если в дальнейшем предполагается работать с ячейками, то хотелось бы видеть на месте ячейки именно ячейку, а не одноячеечный диапазон.

Да, я вижу: в Вашем примере ячейки сливаются (merged) в диапазоны.

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

[sokol92]

а метод addRangeAddress принимает и CellAddress

Быть такого не должно. 

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

Sub Test2
  Dim oDoc, oRanges
  oDoc=ThisComponent
  oRanges=oDoc.createInstance("com.sun.star.sheet.SheetCellRanges")
  oRanges.AddRangeAddress oDoc.Sheets(0).getCellByPosition(0,0).CellAddress, True
End Sub


Сообщение:
arg no.: 0 expected: "com.sun.star.table.CellRangeAddress" actual: "com.sun.star.table.CellAddress".

[eeigor]

Владимир, объект класса ScCellObj имеет оба свойства: CellAddress и RangeAddress. Поправляюсь: получаем ячейку, а передаём oCell.RangeAddress. А вот одноячеечный  диапазон свойства CellAddress не имеет. Да, я прежде не точно выразился, но теперь моя мысль опять в силе.