Простой макрос для LibreOffice Calc (Excel). Где найти информацию?
Несмотря на простоту и минимализм задачи, она сломала мне голову.
Есть файл XLS в котором таблица на 160000+ строк с разными числами.
Нужно:
- Найти все строки, в которых все ячейки пустые;
- Над/под каждой такой строкой прочертить линию;
- Удалить всю пустую строку.
Получается, надо из такого документа:
Сделать такой документ:
UPDATE
Задача решилась самостоятельно. Спасибо за уделённое время. Ничто так не воодушевляет как поддержка неравнодушных людей.
При написании макроса были использованы ресурсы:
В частности конкретные страницы гайда OpenOffice BASIC:
Решением отметил ответ товарища @JohnSUN.
Код получившегося макроса:
REM ***** BASIC *****
Sub Main
Dim oDoc As Object
Dim oSheet As Object
Dim oCellRange As Object
Dim oCursor As Object
Dim lRowCnt As Long
Dim lColCnt As Long
Dim lRowCur As Long
Dim bEmptyRow As Boolean
Dim oBorder As Object
Dim BLine As New com.sun.star.table.BorderLine
' устанавливаем ширину рисуемой линии
BLine.OuterLineWidth = 60
' устанавливаем цвет рисуемой линии
BLine.Color = RGB(0, 0, 0)
' текущий документ
oDoc = ThisComponent
' активная страница
oSheet = oDoc.getCurrentController.activeSheet
' определяем количество колонок по первой строке
lColCnt = 0
While oSheet.getCellByPosition(lColCnt, 0).type <> com.sun.star.table.CellContentType.EMPTY
lColCnt = lColCnt + 1
Wend
' определяем количество строк
oCursor = oSheet.createCursor
oCursor.gotoEndOfUsedArea(True)
lRowCnt = Curs.Rows.Count
' устанавливаем текущую строку
lRowCur = 1
' основной цикл макроса
while lRowCur < lRowCnt
' проверяем пустая ли текущая строка
bEmptyRow = true
For cColCur = 0 to lColCnt-1
If oSheet.getCellByPosition(cColCur, lRowCur).Type <> com.sun.star.table.CellContentType.EMPTY Then bEmptyRow = false
Next cColCur
If bEmptyRow Then
' если найдена пустая строка
' выделяем строку выше
oCellRange = oSheet.getCellRangeByPosition(0, lRowCur-1, lColCnt-1, lRowCur-1)
' рисуем линию по нижнему бортику ячеек
oBorder = oCellRange.TableBorder
oBorder.BottomLine = BLine
oCellRange.TableBorder = oBorder
' удяляем одну строку
oSheet.rows.removeByIndex(lRowCur, 1)
' количество строк уменьшилось на одно после удаления
lRowCnt = lRowCnt - 1
Else
' если найдена не пустая строка
' инкремент индекса текущей строки
lRowCur = lRowCur + 1
End If
Wend
' дальнейшие строки кода выполняют не входившие в условия задачи действия,
' а именно рисуют внешнюю рамку
oCellRange = oSheet.getCellRangeByPosition(0, 0, lColCnt-1, lRowCnt-1)
oBorder = oCellRange.TableBorder
oBorder.BottomLine = BLine
oBorder.TopLine = BLine
oBorder.LeftLine = BLine
oBorder.RightLine = BLine
oCellRange.TableBorder = oBorder
End Sub
Ответы (1 шт):
Вообще-то, мысль "сделать это вручную" не так уж и плоха. Если знать некоторые приёмы работы с таблицами, то это действительно быстрее, чем писать макрос.
Например, можно использовать четвёртый способ отсюда
Небольшую трудность вызывает необходимость отчеркнуть удаляемые строки, но это легко решается с помощью фильтра.
Раз уж этот вопрос касался макроса, то код может быть таким:
Option Explicit
Sub RemoveEmptyRowsAndMark
Dim oSheet As Variant
Dim oCursor As Variant
Dim LastUsedColumn As Long
Dim LastUsedRow As Long
Dim oDescriptor As Variant ' Используется как дескриптор филтрацмм и как дескриптор сортировки '
Dim aRows As Variant
Dim oRange As Variant
Rem Структура aBorder позволит отчеркнуть удалённую строку:
Dim aBorder As Variant
Rem Лист нужно будет отфильтровать:
Dim aFilterFields(0) As New com.sun.star.sheet.TableFilterField
Dim aFilterField As New com.sun.star.sheet.TableFilterField
Rem В качестве листа для чистки использовать активный лист:
oSheet = ThisComponent.getCurrentController().getActiveSheet()
Rem С помощью курсора ограничим область просмотра только рабочим диапазоном
oCursor = oSheet.createCursor()
oCursor.gotoEndOfUsedArea(True)
LastUsedRow = oCursor.getRangeAddress().EndRow
Rem Если лист весь пустой или есть только одна первая строка, то делать нечего:
If LastUsedRow < 1 Then Exit Sub
LastUsedColumn = oCursor.getRangeAddress().EndColumn
Rem В следующей колонке, первой за LastUsedColumn, пишем формулу, которая проверит текущую строку на наличие хоть чего-нибудь и
Rem проставит номер строки или "пустую ячейку"
Rem (Чтобы не вычислять букву колонки для формулы вида Rem =IF(COUNTA($A1:<последняя колонка>1);ROW();"")
Rem используем нотацию R1C1. Ввод такой формулы немного сложнее, чем просто .setFormula()
setRCFormula("=IF(COUNTA(RC1:RC[-1]);ROW();"""")", oSheet.getCellByPosition(LastUsedColumn+1,0))
Rem И ещё одна формула - "необходимо отчеркнуть текущую строку"
setRCFormula("=AND(RC[-1]<>"""";R[1]C[-1]="""")", oSheet.getCellByPosition(LastUsedColumn+2,0))
Rem Заполним этими формулами колонки до LastUsedRow (на 160К+ строк придётся немного подождать)
oSheet.getCellRangeByPosition(LastUsedColumn+1, 0, LastUsedColumn+2, LastUsedRow).fillAuto(com.sun.star.sheet.FillDirection.TO_BOTTOM, 1)
Rem Теперь отфильтруем весь диапазон с этими двумя дополнительными колонками
Rem по значению ИСТИНА в последней колонке. Повторяем выделение UsedRange (он теперь шире на две колонки):
oCursor = oSheet.createCursor()
oCursor.gotoEndOfUsedArea(True)
Rem Фильтрация:
oDescriptor = oCursor.createFilterDescriptor(True)
aFilterField.Field = LastUsedColumn + 2 ' Колонка с признаком "необходимо отчеркнуть текущую строку"
aFilterField.IsNumeric = true
aFilterField.Operator = com.sun.star.sheet.FilterOperator.EQUAL
aFilterField.NumericValue = 1
aFilterFields(0) = aFilterField
oDescriptor.setFilterFields(aFilterFields)
oCursor.filter(oDescriptor)
Rem Теперь видны только строки, которые нужно отчеркнуть линией
oRange = oCursor.queryVisibleCells()
aBorder = oRange.BottomBorder ' Копируем существующую структуру границ диапазона в переменную '
Rem и изменяем её по своему усмотрению
aBorder.OuterLineWidth = 50 ' Толщину линии для отчёркивания можно сделать и больше '
aBorder.Color = 255 ' Цвет можно задать любой '
oRange.BottomBorder = aBorder ' Возвращаем измененную структуру на место - теперь все видимые строки получили нижнюю границу '
Rem Удалим фильтр и отобразим скрытые строки
aRows = oCursor.getRows()
aRows.IsFiltered = False
aRows.IsVisible = True
Rem Теперь осталось отсортировать диапазон по предпоследней колонке:
Call sortRange(ThisComponent, oCursor, LastUsedColumn + 1, False)
Rem ... и удалить вспомогательные колонки:
oSheet.getColumns().removeByIndex (LastUsedColumn+1, 2)
Rem Вот и всё
End Sub
Sub setRCFormula(sRCFormula As String, oCell As Variant)
Rem (см. https://ask.libreoffice.org/en/question/149099/how-to-use-r1c1-formulae-in-calc-macros/)
Dim hParser As Variant
hParser = ThisComponent.CreateInstance( "com.sun.star.sheet.FormulaParser" )
hParser.FormulaConvention = com.sun.star.sheet.AddressConvention.XL_R1C1
oCell.SetTokens(hParser.ParseFormula(sRCFormula, oCell.CellAddress))
End Sub
Sub sortRange(oDoc As Variant, oRange As Variant, Optional nColumn As Long, Optional bContainsHeader As Boolean)
Dim aSortFields(0) As New com.sun.star.util.SortField
Dim aSortDesc(1) As New com.sun.star.beans.PropertyValue
If IsMissing(nColumn) Then nColumn = 0
If IsMissing(bContainsHeader) Then bContainsHeader = True
oDoc.getCurrentController().select(oRange)
aSortFields(0).Field = nColumn
aSortFields(0).SortAscending = TRUE
aSortDesc(0).Name = "SortFields"
aSortDesc(0).Value = aSortFields()
aSortDesc(1).Name = "ContainsHeader"
aSortDesc(1).Value = bContainsHeader
oRange.Sort(aSortDesc())
Rem уберём выделение
oDoc.getCurrentController().Select(oDoc.createInstance("com.sun.star.sheet.SheetCellRanges"))
End Sub

