eeigor
|
Михаил, день добрый! Но ведь это не так легко исправить. Проще реализовать функцию Union, которая, к примеру, объединит пустые ячейки, полученные методом queryEmptyCells, и предоставит возможность перебрать их. Тот способ от @sokol92 с использованием метода fillAuto был трюковым (для заполнения пустых ячеек).
|
|
« Последнее редактирование: 19 Апрель 2022, 09:08 от eeigor »
|
Записан
|
Ubuntu 18.04 LTS • LibreOffice 7.3.2.2 Community
|
|
|
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&)
|
|
« Последнее редактирование: 19 Апрель 2022, 11:45 от eeigor »
|
Записан
|
Ubuntu 18.04 LTS • LibreOffice 7.3.2.2 Community
|
|
|
sokol92
|
Что-то вроде Голосую за For Each oCell In oRanges.AllCells и For Each oCell In oRange.AllCells
|
|
|
Записан
|
Владимир.
|
|
|
mikekaganski
|
А если к методу getCells добавить Нет. Это несовместимое изменение, ломающее ABI. Но вот сделать гибкий объект, которые может проходить по разным типам ячеек - это было бы хорошо. С другой стороны, может быть, не AllCells, а EmptyCells? тогда Cells + EmptyCells - это полный набор, и можно индивидуально использовать то или другое. В любом случае - нужен баг до того, как что-то реализовывать.
|
|
« Последнее редактирование: 19 Апрель 2022, 15:20 от mikekaganski »
|
Записан
|
|
|
|
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()
|
|
« Последнее редактирование: 21 Апрель 2022, 20:42 от eeigor »
|
Записан
|
Ubuntu 18.04 LTS • LibreOffice 7.3.2.2 Community
|
|
|
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-свойств был сохранён.
|
|
« Последнее редактирование: 21 Апрель 2022, 20:33 от eeigor »
|
Записан
|
Ubuntu 18.04 LTS • LibreOffice 7.3.2.2 Community
|
|
|
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
|
|
« Последнее редактирование: 23 Апрель 2022, 23:27 от eeigor »
|
Записан
|
Ubuntu 18.04 LTS • LibreOffice 7.3.2.2 Community
|
|
|
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) Пример задвоения диапазонов на скриншоте:
|
|
« Последнее редактирование: 24 Апрель 2022, 22:01 от eeigor »
|
Записан
|
Ubuntu 18.04 LTS • LibreOffice 7.3.2.2 Community
|
|
|
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
|
|
« Последнее редактирование: 26 Апрель 2022, 10:56 от sokol92 »
|
Записан
|
Владимир.
|
|
|
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).
|
|
« Последнее редактирование: 25 Апрель 2022, 22:12 от eeigor »
|
Записан
|
Ubuntu 18.04 LTS • LibreOffice 7.3.2.2 Community
|
|
|
sokol92
|
Не совсем ясно, что будет при дублировании ключа в словаре Ясно, спасибо за замечание. Забыл добавить счетчик при формировании ключа - исправил.
|
|
|
Записан
|
Владимир.
|
|
|
eeigor
|
Владимир, я внимательно проанализировал ваш пример, но в плане создания коллекции Cells, с возможностью перебора всех элементов, в том числе пустых ячеек. "Map" вместо VBA "Collection". Вариант вполне рабочий. Разница только в том, с каким объектом пользователь будет работать потом, и что для него удобнее. Единственно, на что я обратил внимание, так это вовсе необязательно работать с ячейкой как с одноячеечным диапазоном. Структура CellAddress проще, а метод addRangeAddress принимает и CellAddress наряду с RangeAddress. Если в дальнейшем предполагается работать с ячейками, то хотелось бы видеть на месте ячейки именно ячейку, а не одноячеечный диапазон. Да, я вижу: в Вашем примере ячейки сливаются (merged) в диапазоны. P.S. Владимир, ваши примеры очень полезны. Не в порядке критики, а так, в порядке размышлений, скажу следующее. Непросто найти компромисс между универсальностью применения функции и сложностью её реализации. Вы придерживаетесь первого (функция принимает аргумент в любом виде), а я напротив: более явно определяю параметры функции и облегчаю реализацию. Вы "помогаете" пользователю, а я "дисциплинирую" его.  Компромисс – штука субъективная.
|
|
« Последнее редактирование: 28 Апрель 2022, 11:32 от eeigor »
|
Записан
|
Ubuntu 18.04 LTS • LibreOffice 7.3.2.2 Community
|
|
|
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 не имеет. Да, я прежде не точно выразился, но теперь моя мысль опять в силе.
|
|
« Последнее редактирование: 28 Апрель 2022, 13:25 от eeigor »
|
Записан
|
Ubuntu 18.04 LTS • LibreOffice 7.3.2.2 Community
|
|
|
|