1

Несмотря на простоту и минимализм задачи, она сломала мне голову.

Есть файл XLS в котором таблица на 160000+ строк с разными числами.

Нужно:

  1. Найти все строки, в которых все ячейки пустые;
  2. Над/под каждой такой строкой прочертить линию;
  3. Удалить всю пустую строку.

Получается, надо из такого документа:

введите сюда описание изображения

Сделать такой документ:

введите сюда описание изображения

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
9
  • Записать макрос, потом отредактировать. Для Excel всё просто, а вот для OOo придётся искать, как узнать значение ячейки (я не знаю, как).
    – Qwertiy
    27 окт 2020 в 22:53
  • @Qwertiy лет 20 назад Visual-Basic был любимым ЯП. Какие славные были времена. Врядли в Excel можно вручную сделать макрос с поиском пустой строки, разве что поиск пустой ячейки.
    – DiD
    27 окт 2020 в 22:58
  • В excel'е написание такого макроса заняло бы несколько минут, а как сделать в OOo я понятия не имею. У MSO красивая объектная модель, позволяющая читать и писать значения, менять стили и всё остальное - надо только записать макрос, добавить проверки и радоваться результату. Когда будет тормозить, то погуглить, как на время выполнения макроса отключить обновление экрана. А у OOo в записанном макросе будет полная жесть - там вызовы каких-то команд и свойств будут внутри строк, передаваемых в другие команды. Никакого автодополнения, никаких хороших идей по модификации кода...
    – Qwertiy
    27 окт 2020 в 23:02
  • в OpenOffice Calc 3 версии появилась возможность выполнять какие то готовые уже макросы из Excel, сделанные на VBA. Для этого эту возможность надо активировать в настройках (хотя например у меня в Libre Office это уже активировано). Но вообще ЯП там называется OpenOffice BASIC и заявляется что он похож на VBA (хотя по API конечно отличается). Макросы на OO не писал, поэтому не подскажу, но в сети можно найти множество даже учебников, так что задача на самом деле решаемая.
    – Softovick
    27 окт 2020 в 23:56
  • 1
    @DiD Ну, если речь о мануале, то давно признано, что книга Питоньяка даёт не только ответы на самые распространённые вопросы, но и хорошего вдохновляющего пинка к изучению объектной модели офиса. Хоть оригинальная книга(в ODT или в PDF), хоть немного устаревший перевод Дмитрия Чернова Просто столкнувшись с задачей, найти в оглавлении нужный раздел и скопипастить рабочий код.
    – JohnSUN
    28 окт 2020 в 9:21

1 ответ 1

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
4
  • Только я все равно до конца не вкуриваю, как он удаляет только видимые строки, выбранные авто-фильтром? я пытаюсь сделать также, но удаляет не только видимые строки но и спрятанные между ними строки.
    – DiD
    31 окт 2020 в 2:00
  • Нет-нет, фильтр накладывается временно, только чтобы отыскать непустые строки, после которых идёт пустая строка - все эти отфильтрованные строки отчёркиваются по нижнему краю, после этого фильтр отменяется. А "удаление" строк делается сортировкой - они остаются в диапазоне, просто съезжают вниз. Если строка только выглядит пустой, но, например, состоит из формул типа =ЕСЛИ(СЕГОДНЯ()<ДАТА(2020;11;1);"";3,62) (сегодня ещё пусто, а завтра появится число или текст), то мы не потеряем эту строку, она только сдвинется вниз. А если строка реально пустая, то она смешается с остальными пустыми внизу
    – JohnSUN
    31 окт 2020 в 14:46
  • в моем случае к сожалению нет такого поля по которому можно было бы восстановить порядок строк. И безусловно такое поле легко сделать, просто заполнив 1,2, потом двойной клик на квадратик и поле заполнилось до конца. Но на моём файле почему-то всё зависает. По всей видимости, для сохранения большого количества строк в одной странице использованы какие-то недокументированные хаки, расширяющие диапазон возможных строк. Это приводит к постоянным зависаниям и вылетаниям Calc.
    – DiD
    31 окт 2020 в 16:06
  • Одни функции работают нормально и моментально (например Сохранить), другие ~ на минуту морозят компьютер и в 30% вылетает из-за переполнения стека (например, на функции Сохранить как). Даже сложно предугадать, какая функция будет работать а какая не будет - механизм их отбора остаётся загадкой.
    – DiD
    31 окт 2020 в 16:06

Ваш ответ

Нажимая на кнопку «Отправить ответ», вы соглашаетесь с нашими пользовательским соглашением, политикой конфиденциальности и политикой о куки

Всё ещё ищете ответ? Посмотрите другие вопросы с метками или задайте свой вопрос.