Форум поддержки пользователей. LibreOffice, Apache OpenOffice, OpenOffice.org

Форум поддержки пользователей. LibreOffice, Apache OpenOffice, OpenOffice.org

17 Сентябрь 2019, 16:13 *
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
Вам не пришло письмо с кодом активации?

Войти
Новости: Здесь можно поблагодарить участников форума Улыбка
 
   Начало   Помощь Поиск Войти Регистрация    задать вопрос  
Страниц: 1   Вниз
  Печать  
Автор Тема: Макрос для определения диапазона объединенных ячеек  (Прочитано 4017 раз)
0 Пользователей и 2 Гостей смотрят эту тему.
JohnSUN
Капитана в тот день называли на "ты"
Гуру
*******
Offline Offline

Пол: Мужской
Расположение: Киев
Сообщений: 2 764


Помогаю людям и компьютерам понимать друг друга


WWW
« Ответ #31228: 15 Июнь 2015, 16:26 »

Ну, если на скорую руку, просто для примера, то так:
Код:
Sub getAddrMergedCells
Dim oSheet As Variant
Dim oCursor As Variant
Dim oCellRangeByName As Variant
Dim nRowCount As Long
Dim nColCount As Long
Dim oCellByPosition As Variant
Dim oMergCursor As Variant
Dim i&, j&
Dim aData As Variant

oSheet = ThisComponent.getCurrentController().getActiveSheet() ' Можно и .getByIndex(чего-то там)... Это же только пример ;-)
oCursor = oSheet.createCursor() ' Это обычный курсор, просто чтобы определить занятое место
oCursor.gotoEndOfUsedArea(True)
If not oCursor.getIsMerged() Then
MsgBox("На этом листе (в заполненной области) объединенных ячеек не обнаружено...")
Exit Sub
EndIf

nRowCount = oCursor.getRows().getCount()-1
nColCount = oCursor.getColumns().getCount()-1
aData = Array()
REM Здесь, как ты и делал, перебираем ячейки по одной
For j = 0 To nRowCount
For i = 0 To nColCount
oCellByPosition = oSheet.getCellByPosition(i, j)
If oCellByPosition.getIsMerged() Then ' Если она из объединенных - слизываем адрес всей области
oMergCursor = oSheet.createCursorByRange(oCellByPosition)
oMergCursor.collapseToMergedArea()
getIndexOrAdd(oMergCursor.AbsoluteName, aData) ' Чтобы не повторяться, собираем уникальные строки
EndIf
Next i
Next j
MsgBox "Найдено " + (UBound(aData)+1) + " объединенных диапазонов" + Chr(10) + Join(aData, Chr(10))
End Sub

Function getIndexOrAdd(key, aData)
Dim l&, r&, m&, N&, i&
l=LBound(aData)
r=UBound(aData)+1
N=r
While (l<r)
m=l+Int((r-l)/2)
If aData(m)(0)<key Then
l=m+1
Else
r=m
EndIf
Wend
If r=N Then
ReDim Preserve aData(0 To N)
aData(N) = key
getIndexOrAdd = N
ElseIf  aData(r)=key Then
getIndexOrAdd = r
Else
ReDim Preserve aData(0 To N)
For i = N-1 To r Step -1
aData(i+1)=aData(i)
Next i
aData(r) = key
getIndexOrAdd = r
EndIf
End Function
Записан

Владислав Орлов aka JohnSUN
Благодарить-не зазорно.
Подарить благо создателям офиса, нашему ресурсу, мне
Страниц: 1   Вверх
  Печать  
 
Перейти в:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2006-2009, Simple Machines Valid XHTML 1.0! Valid CSS!