Посоветуйте алгоритм решения

[siti]

Demo code:

Dim oColumnHeaders As New Collection
Dim sh, rg, cell
Dim j&

sh = ThisComponent.Sheets(0)
rg = sh.getCellRangeByPosition(0, 4, 30, 4)
For j = 0 To 30  'rg.RangeAddress.EndColumn | rg.Columns.Count - 1
   cell = rg.getCellByPosition(j, 4)
   oColumnHeaders.Add cell.CellAddress.Column, cell.String
Next

решение рабочее, пойдет.
спасибо!
Вылетает правда на пустых ячейках и такой вариант почему то не помогает:

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


For j = 0 To 28 'rg.RangeAddress.EndColumn '| rg.Columns.Count - 1
if ThisComponent.Sheets(0).getCellByPosition(0,6).Type <> com.sun.star.table.CellContentType.EMPTY then
    cell = ThisComponent.Sheets(0).getCellByPosition(j,6)
    oColumnHeaders.Add cell.CellAddress.Column, cell.String
   end if
Next


[eeigor]

Файл приложен

Стоит задача создать процедуру, которая присваивает переменным (название которых совпадает с тегом) значение номера колонки в которой стоит данный тег.

См. скриншот и код. Вместо многих переменных - один объект oTags As Collection.

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

Sub Main
Dim oTags As New Collection
Dim sh, rgs, rg, cell
Dim j&, item, s$
Dim arr()

'arr() = Array("gid", "adress", "spl" _
' , "m0", "m1", "m2", "m3", "m4", "m5", "m6", "m7", "m8", "m9", "m10", "m11" _
' , "price1", "price2", "price3", "price4", "price5", "photo1", "photo2", "photo3")

sh = ThisComponent.Sheets(0)
rg = sh.getCellRangeByPosition(0, 3, 22, 3)
arr() = rg.DataArray

'For j = 0 To 22
' cell = sh.getCellByPosition(j, 3)
' oColumnHeaders.Add cell.CellAddress.Column, cell.String
'Next

rgs = ThisComponent.createInstance("com.sun.star.sheet.SheetCellRanges")
rgs.addRangeAddress(rg.RangeAddress, False)
For Each cell In rgs.Cells
oTags.Add cell.CellAddress.Column, cell.String
Next

s = "Tag Count:  " & oTags.Count & Chr(10)
For Each item In oTags
s = s & " " & item
Next
MsgBox s, , "Column Indices"

MsgBox arr(0)(0) & " = " & oTags(arr(0)(0)), , "Example"

s = "Tag Count:  " & oTags.Count & Chr(10)
For Each item In arr(0)
s = s & Chr(10) & item & " = " & oTags(item)
Next
MsgBox s, , "Extract column index from Collection by Tag"
End Sub

Прим. В отличие от CellRanges CellRange не содержит свойства Cells. Удобно для перебора ячеек в цикле For Each, причём:
For Each cell In rgs.Cells
автоматически пропускает пустые ячейки (только Used cells).

[eeigor]

Вылетает правда на пустых ячейках

Потому что ключ не может быть пустым. И у вас не должно быть безымянного столбца.
For j = 0 To 28
Но в примере меньше столбцов (23)

и такой вариант почему то не помогает:

Конечно не помогает. Замените в цикле 0 на j
.getCellByPosition(0,6).Type

[eeigor]

Вопрос:
У кого-н. есть решение (зд. бы пригодилось) для фильтрации диапазона по столбцам.
Excel'исты делают это.
Edit: Причём по нескольким!
По ссылке выше – по одному или по шаблону.
Своего рода, Автофильтр по горизонтали.

Я рассмотрел пример автора в ответе #10. Вариант с транспонированием диапазона и фильтрацией по строкам мне кажется неудобным.
Преобразовывать диапазон в список (базу данных) с полем "Месяц" тоже кажется неудобным. Данных мало, и лучше всего хранить данные в виде, удобном для вывода на печать (как сейчас).

[siti]

Я рассмотрел пример автора в ответе #10. Вариант с транспонированием диапазона и фильтрацией по строкам мне кажется неудобным.

Я всяко обдумал насчет "горизонтального автофильтра", но может мозг за годы работы с такой табличкой уже не видит других вариантов. Не вижу преимуществ для работы в нашем случае. Месяцев всего 12, а строк под сотню. Процесс выбора строк по "только пусто" в нужных месяцах или "хотябы один пусто" реализован и вполне устраивает.

Спасибо за помощь!

Есть еще одна проблема с аварийным закрытие по ошибке Libreoffice при выполнении копирования диапазона с листа2 на лист Презентации. Если не победю - напишу.

[eeigor]

А что думает Владимир (@sokol92): нужна такая реализация АвтоФильтра по горизонтали? «Ненормализованный» подход к хранению данных. Но не всё же «пихать» в базу данных...

Да, месяцы – это массив, и сразу нарушение НФ-1 (первой нормальной формы). Зато удобно и наглядно (раз вправо не растёт – значит допустимо). АвтоФильтр по горизонтали + координатное выделение (для удобства ввода данных), и электронная таблица получает (получила бы) особое преимущество перед СУРБД.

[eeigor]

@siti, опишите все критерии, по которым выбирает пользователь.

[eeigor]

Как всё-таки фантастически просто решается проблема горизонтальной фильтрации в Excel 20192021 без программирования.

Вот здесь.


А мы можем сообща как-то реализовать функции динамических массивов?

New dynamic array functions (6)

Function   Purpose
FILTER   Filter data and return matching records
RANDARRAY   Generate array of random numbers
SEQUENCE   Generate array of sequential numbers
SORT   Sort range by column
SORTBY   Sort range by another range or array
UNIQUE   Extract unique values from a list or range

Edit:
NOTE: Dynamic arrays and the new functions above are only available Excel 365 and Excel 2021.

[siti]

А как мне проверить oTags на наличие определенного тега в коллекции?
При oTags("неверный_ключ") выдает ошибку, а я хочу анализировать если ли в выборке конкретный месяц проверкой в цикле oTags("m0...m11")

Только перебирать через For Each item In oTags ?

[eeigor]

Выдаёт ошибку? Прекрасно. Это и есть ответ. Напишите коротенькую функцию

Demo code:
Function TagExists(oTags As Object, sTag$) As Boolean
    Dim result
    On Local Error Resume Next
    result = oTags(sTag)
    TagExists = (Err <> 0)
End Function

[kompilainenn]

А мы можем сообща как-то реализовать функции динамических массивов?

Баги 126573 и 127808

[eeigor]

@kompilainenn, спасибо.
Первый баг говорит о фактически новом поведении, а не просто о новых функциях. Я всерьёз о них не задумывался, так как и испытать негде (Excel 2016). Но в свете обсуждаемой здесь задачи ощутил в них ясную необходимость.

Прежде всего: FILTER, UNIQUE, SORT
+ XLOOKUP.

FILTER – первая в очереди.
КМК, реализовать можно, задействовав штатные возможности, с вычислениями на скрытом рабочем листе (потом удалить). Хранить в библиотеке 'My Macros'.

[kompilainenn]

Ты собираешься макросами запилить функции динамических массивов? Удачи?

[eeigor]

"Динамический" здесь не главное. Быстродействие тоже вторично, как в примере ТС. Важна функциональность. UDF FILTER, например, должна вернуть первое значение в левый верхний угол диапазона, то есть в ячейку вызова, а сам диапазон (оставшиеся ячейки) с учётом его ориентации заполнить вправо и вниз от неё, предварительно проверив, что целевой диапазон свободен (#SPILL! error, если диапазон занят; #VALUE! error, если размерность массивов не совпадает; #CALC! error, если не найдено соответствие условию, а третий аргумент не задан – синтаксис функции по ссылке ниже). Вполне выполнимо. Вот только как задавать условие фильтра (второй аргумент – logic)? Разбор этой "логики" и есть сложность, которой хочется избежать. Точнее, как принять этот параметр, чтобы потом, скажем, передать функции COUNTIFS или SUMPRODUCT? Есть ли такая служба/класс/сервис?

https://exceljet.net/excel-functions/excel-filter-function

[siti]

Выдаёт ошибку? Прекрасно. Это и есть ответ. Напишите коротенькую функцию

Demo code:
Function TagExists(oTags As Object, sTag$) As Boolean
    Dim result
    On Local Error Resume Next
    result = oTags(sTag)
    TagExists = (Err <> 0)
End Function

Может я что-то не понял, но такая конструкция выдает только номер колонки. Yes не выдает

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


Tag=FillTags(oDoc,0,6)
if tagexists(Tag,"m0") then
msgbox "yes"
end if
msgbox Tag("m0")