Определить поддиапазон данных на листе Calc.

Автор convas, 23 августа 2010, 23:28

0 Пользователи и 1 гость просматривают эту тему.

convas

Появилась вот такая задача.
Есть разбросанные данные в области, например, C3:N42
Выбирается область для исследования, например, E8:K31
В ней нужно найти границы области, занимаемой данными (то есть определить, что это область F9:I28), с помощью макроса, не перебирая все значения ячеек в исследуемой области (E8:K31).
Можно ли это сделать и каким должен быть этот макрос?
Пример прилагается.

[вложение удалено Администратором]

dr.Faust

Цитата: convas от 23 августа 2010, 22:28не перебирая все значения ячеек в исследуемой области (E8:K31)
Как я понимаю в общем случае невозможно - в пустых периметрах придётся перебрать всё.
А так макрос приметивен - просматриваем все ячейки первого столбца, если они пусты - переходим ко второму и т.д. пока не обнаружим первую занятую ячейку для столбца с наименьшим номером - он будет первым столбцом диапазона, то же повторяем для последнего столбза и для строк. Т.е. тупо действуем методом перебора...
Свобода информации - свобода личности!

JohnSUN

Сделать можно. Каким должен быть этот макрос пока могу описать только на пальцах - есть только идея, алгоритм, реализацией не занимался.
Для анализируемого диапазона сразу же определяем координаты верхней левой и нижней правой клеток (номера строк и столбцов).
В стандартном поиске по регулярному выражению .* в выделенном диапазоне ищем все (в терминах ГПИ - Только текущее выделение, Регулярные выражения, Найти все). Получаем пачку выделенных поддиапазонов (или в случае неудачи - ничего не получаем).
У Питоньяка что-то было на тему "что сейчас выделено", там можно было перебрать все зачерненные поддиапазоны.
Для каждого из них тоже определяем координаты верхней левой и нижней правой клеток (номера строк и столбцов).
Остается отыскать два минимума и два максимума по поддиапазонам и, возможно, обрезать их по границам анализируемого диапазона (на случай, если массив данных пересечет границу и уйдет за пределы анализируемой области. Впрочем, излишки и не должны попасть в результат поиска).
Ну и дело техники - по четырем числам получить читабельный адрес диапазона.
Владислав Орлов aka JohnSUN
Благодарить-не зазорно.
Подарить благо создателям офиса, нашему ресурсу, мне

dr.Faust

Хм... а это будет работать.
Цитата: JohnSUN от 26 августа 2010, 22:25У Питоньяка что-то было на тему "что сейчас выделено"
Это элементарно - .getCurrentSelection вернёт массив диапазонов. Но если делать минуя диспетчер то будет быстрее, без ненужных спецэффектов и массив диапазонов получим сразу как результат поиска.
Обрезать ничего не потребуется если искать в выделенном...
Свобода информации - свобода личности!

Рыбка Рио

Может как-нибудь так? (только развить нужно чуть-чуть)

REM  *****  BASIC  *****

Sub Main
Dim oRange
Dim Doc As Object, CC As Object, oSheet As Object, oSheet1 As Object, document as object, dispatcher as object
Doc = ThisComponent
CC = Doc.CurrentController
document = CC.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())
oSheet = CC.ActiveSheet
oRange = Doc.CurrentSelection
Doc.Sheets.insertNewByName("tmp", createUnoValue("short", 0))
CC.setActiveSheet(Doc.Sheets(0))
dispatcher.executeDispatch(document, ".uno:Paste", "", 0, Array())
oRange1 = Doc.Sheets(0).createCursor()
oRange1.gotoStartOfUsedArea(False)
oRange1.gotoEndOfUsedArea(True)
msgbox  getRangeName(oRange1)
msgbox getRangeName(oRange)
CC.setActiveSheet(oSheet)
Doc.Sheets.removeByName("tmp")
End Sub

Function getRangeName(oRg) as string
Dim sSh$,sC1$,sR1$,sC2$,sR2$
oAddr = oRg.getRangeAddress
oSh = oRg.getSpreadSheet
sC1 = oSh.Columns.getByIndex(oAddr.StartColumn).getName
sC2 = oSh.Columns.getByIndex(oAddr.EndColumn).getName
sR1 = cStr(oAddr.StartRow +1)
sR2 = cStr(oAddr.EndRow +1)
s = sC1+sR1+":"+sC2+sR2
getRangeName = s
End Function
ubuntu 12.04 + LibO3.6.0

JohnSUN

Вау, Клио, душевно! Изящная идея!
То есть, если гора не идет к Магомету... В смысле, если начало исследуемого диапазона далеко от A1, то мы его туда перетаскиваем (только не простым копированием, а специальным - с игнорированием пустых ячеек и прибиванием формул, чтоб побыстрее было). Затем одним движением Ctrl-End (".uno:GoToEndOfData") определяем нижнюю правую клетку - и уже почти знаем количество строк и столбцов в искомой области...
Ну, с поправкой на пустые строки и столбцы в начале исследуемого диапазона. К сожалению, способа прыгнуть в первую клетку заполненной области, если она не сплошная, похоже, не существует. Только в A1 через ".uno:GoToStart" или в первую клетку сплошного диапазона через gotoStartOfUsedArea.
Вот если бы был способ быстро заполнить пустые клетки какими-то маркерами... И за счет этих маркеров получить сплошную область, включающую непустые клетки и только их. Ну, что-то типа функции "(слева от меня меньше 8 значит я 0, иначе я 8) + (сверху от меня меньше 4 значит я 0, иначе я 4)...", которую воткнуть во все пустые ячейки. Или как-то иначе... В общем, если развивать в этом направлении, то не "чуть-чуть". А жаль! Начало было заманчивое.

dr.Faust, ну да, поиск, разумеется, тоже не через ГУЙ диспетчер. Я про пользовательский интерфейс помянул к ночи только из-за того что проверял действенность способа именно в нем. А в окончательном коде нужно будет что-то типа oSelRange.createSearchDescriptor() и т.д.

В общем, стоило над задачкой задуматься - и оказалось, что она интересная  ;D Спасибо, convas!
Владислав Орлов aka JohnSUN
Благодарить-не зазорно.
Подарить благо создателям офиса, нашему ресурсу, мне

dr.Faust

Поиск мне кажется лучше.
Вот функция:
Function getDataRange (ByVal ScopeRang As Object, bMerge As Boolean) As Variant
Dim SrhDesc As Object
Dim SrhRslt As Object
Dim oDataRanges() As Object
Dim oDataRange As Object
Dim l As Long

If IsMissing(bMerge) Then bMerge = 1
If ScopeRang.supportsService("com.sun.star.sheet.SheetCellRange") Then
SrhDesc = ScopeRang.createSearchDescriptor
' настраиваем ддискриптор поиска
SrhDesc.SearchRegularExpression = 1
SrhDesc.SearchString = ".+"
' ищим
SrhRslt = ScopeRang.findAll(SrhDesc)

If IsNull(SrhRslt) Then Exit Function

Dim lNRanges As Long
lNRanges = SrhRslt.getCount
If bMerge Then
If lNRanges=1 Then
oDataRange=SrhRslt.getByIndex(0)
ElseIf lNRanges>1 Then
oDataRange=ScopeRang.getSpreadsheet.getCellRangeByPosition(SrhRslt.getByIndex(0).getRangeAddress.StartColumn, SrhRslt.getByIndex(0).getRangeAddress.StartRow,SrhRslt.getByIndex(lNRanges-1).getRangeAddress.EndColumn,SrhRslt.getByIndex(lNRanges-1).getRangeAddress.EndRow)
Else

End If
getDataRange = oDataRange
Exit Function
Else
ReDim oDataRanges(lNRanges-1)
For l=0 To lNRanges-1
oDataRanges(l)=SrhRslt.getByIndex(l)
Next
getDataRange = oDataRanges
End If
End If
End Function

Она возвращает диапазон данных из диапазона переданого на вход, если второй параметр 1 или опущен.
Если параметр 0, то возвращает массив непрерывных поддиапазонов с данными.
Свобода информации - свобода личности!

JohnSUN

О! Очень похоже на окончательный вариант. Только:
1. Почему функция? С точки зрения оператора процедура здесь - ИМХО! - была бы лучше. То есть, по задаче - вот выделил я кусок таблицы, шлепнул кнопку на панели или горячую клавишу и выделение схлопнулось в прямоугольник вокруг данных, если они есть, или сжалось до верхней левой клетки выделения, если данных нет.
2. Простой Exit Function на IsNull(SrhRslt) - опять-таки ИМХО - стоило бы заменить на возврат хотя бы ячейки ScopeRang.getRangeAddress.StartColumn/StartRow (а там уже увидим, что она пустая)
3. К сожалению, просто адреса нижней правой клетки SrhRslt.getByIndex(lNRanges-1) будет мало - какой-нибудь (lNRanges-4) может оказаться правее последнего найденного (или ниже? От направления поиска, кажется, зависит). И те же проблемы могут возникнуть с верхней левой ячейкой. Так что все-равно нужно их перебирать и отыскивать min и max для колонок и строк.

(Чес-слово, сам бы сел и написал-отладил! Уж больно задачка забавная! Да времени совершенно нет: сижу переделываю одну хитровыкрученную обработку на 1С 8.1, в основном зубодробительные запросы упрощаю. Нужно на порядок увеличить скорость работы кода. До конца августа осталось всего-ничего, а там еще ковырять и ковырять... Кстати! Здесь кто-нибудь запросы с иерархиями писал? Не пособите?)
Владислав Орлов aka JohnSUN
Благодарить-не зазорно.
Подарить благо создателям офиса, нашему ресурсу, мне

dr.Faust

1 Зачем процедура? Мало ли где понадобится... Нужно выделять диапазон - напишите процедуру которая это будет делать и пусть она юзает эту функцию.
2 Зачем? Опять же - не известно кто и как будет юзать.
3 Да - уже сам дотумкал. Если будет время поправлю завтра. Просто в моей задаче диапазон всегда или одна строка или одна колонка, так что там это не актуально, вот и упустил из вида.
Свобода информации - свобода личности!

smaharbA

Есть достаточно простой метод, известный со времен МСО, без перебора и прочих вычислений
Я конечно далек от мысли... (с)

convas

Цитата: smaharbA от 21 сентября 2010, 06:37
Есть достаточно простой метод, известный со времен МСО, без перебора и прочих вычислений

Какой?

dr.Faust

Цитата: smaharbA от 21 сентября 2010, 06:37
Есть достаточно простой метод, известный со времен МСО, без перебора и прочих вычислений
просим-просим...
Свобода информации - свобода личности!

smaharbA

Поправлюсь - за один проход по столбцам
(и когда уберется аджакс или что там со страницы ответа, не дает нормально редактировать в отличие от быстрого ответа)

function getusedrange(byref reg)
dim sheet,con,address,sel,dispatcher,maxr,minr,moxc,minc,cur,sela
con= thisComponent.getCurrentController()
address=reg.getRangeAddress()
sheet= reg.getSpreadsheet()
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
maxr=address.StartRow
minr=address.EndRow
maxc=address.StartColumn
minc=address.EndColumn
cols=reg.getColumns().count - 1
rows=reg.getRows().count - 1
for n=0 to cols
con.select(reg.getCellByPosition(n,0))
dispatcher.executeDispatch(con.Frame, ".uno:GoDownToEndOfData", "", 0, array())
sel=thisComponent.getCurrentSelection()
sela=sel.getRangeAddress()
cur=sela.StartRow
if cur <= address.EndRow then
if minr > cur then minr = cur
cur=sela.StartColumn
if minc > cur then minc = cur
if maxc < cur then maxc = cur
con.select(reg.getCellByPosition(n,rows))
dispatcher.executeDispatch(con.Frame, ".uno:GoUpToStartOfData", "", 0, a())
sel=ThisComponent.CurrentSelection
sela=sel.getRangeAddress()
cur=sela.StartRow
if cur > maxr then maxr = cur
end if
next
getusedrange=sheet.getCellRangeByPosition(minc,minr,maxc,maxr)
end function

sub Main
sheet=thisComponent.getSheets().getByIndex(0)
reg=sheet.getCellRangeByName("E8:L31")
r = thisComponent.createInstance("com.sun.star.sheet.SheetCellRanges")
r.insertByName("", getusedrange(reg))
msgbox r.getRangeAddressesAsString()
end sub
Я конечно далек от мысли... (с)

convas

#13
Ошибка, нужно
dispatcher.executeDispatch(con.Frame, ".uno:GoUpToStartOfData", "", 0, array())

[вложение удалено Администратором]

smaharbA

ну да, а() это по привычке с параметрами, а тут они и не нужны
Я конечно далек от мысли... (с)