主页 / 问题 / 1196503
Accepted
DiD
Asked:2021-10-28 06:36:41 +0000 UTC2021-10-28 06:36:41 +0000 UTC

LibreOffice Calc (Excel) 的简单宏。在哪里可以找到信息？

  • 772

尽管任务简单而极简，但它打破了我的头脑。

有一个 XLS 文件，其中有一个包含 160000 多行不同数字的表格。

需要：

  1. 查找所有单元格为空的所有行；
  2. 在每条这样的线上方/下方画一条线；
  3. 删除整个空行。

事实证明，有必要从这样的文件：

在此处输入图像描述

制作这样的文档：

在此处输入图像描述

更新

问题自行解决了。感谢您的时间。没有什么比爱心人士的支持更能激发灵感了。

在编写宏时，使用了以下资源：

特别是 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
excel

1 个回答

  1. Best Answer

    其实，“亲手做”这个想法也不错。如果您知道一些使用表格的技巧，那么它确实比编写宏要快。

    例如，您可以使用此处的第四种方法

    必须在要删除的行下划线有点棘手，但这可以通过过滤器轻松解决。

    由于这个问题是关于宏的，所以代码可能是这样的：

    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
    • 1

相关问题