LibreOffice Calc Basic 搜索和替换宏

Question

我将一步步告诉你如何解决这个问题。

主要问题是复制替换单元格以及格式。有几种方法可以执行此操作 - 通过剪贴板（通常的复制和粘贴 - 第5.23.1. 使用剪贴板复制电子表格单元格），使用.getTransferable()（第5.23.6. 剪贴板的替代品——可传输的内容）但最有效的方法是oSheet.CopyRange()（第5.23.2. 不使用剪贴板复制电子表格单元格）

不幸的是，这种方法只在单个电子表格中有用，而您的数据和替换列表位于不同的电子表格中。因此，我们将使用一个不太复杂的技巧 - 我们将在当前工作簿中创建一个临时工作表，其中包含替换列表的副本，完成工作后我们将删除它。

习惯上，所有 Dim 操作符都放在过程的开头。我将在使用每个变量之前对其进行描述。

为了在需要更改文本字符串时不必在整个宏代码中搜索文本字符串，我们将它们放在过程的最开始处：

Sub SearchAndReplaceItems
Const sSearchReplaceFilePath = "C:\Users\One\Info\Corrections.ods"
Const sSearchReplaceRangeName = "SearchRegExps"

与往常一样，初步数据检查和配置占用了大部分代码。

这工具库包含许多有用的函数。我们将使用GetDocumentType()函数和OpenDocument()函数

    GlobalScope.BasicLibraries.LoadLibrary("Tools")
' Get the current document
Dim oDoc As Variant 
    oDoc = ThisComponent
    If GetDocumentType(oDoc) <> "scalc" Then
        MsgBox "This macro is intended for use with spreadsheets only!", MB_ICONSTOP, "Continuation of work is impossible"
        Exit Sub
    EndIf

如果替换词典不存在，那么其他一切都毫无意义

    If Not FileExists(sSearchReplaceFilePath) Then
        MsgBox "File '" & sSearchReplaceFilePath & "' not found!", MB_ICONSTOP, "Continuation of work is impossible"
        Exit Sub
    EndIf 
Dim oSearchReplaceDoc As Variant 
    oSearchReplaceDoc = OpenDocument(ConvertToURL(sSearchReplaceFilePath), Array())

让我们确保替换电子表格没有损坏

Dim oNamedRanges As Variant
    oNamedRanges = oSearchReplaceDoc.NamedRanges
    If Not oNamedRanges.hasByName(sSearchReplaceRangeName) Then
        MsgBox "The '" & sSearchReplaceFilePath & "' file does not contain a named range '" _
            & sSearchReplaceRangeName & "'!", MB_ICONSTOP, "Continuation of work is impossible"

此时我们可以关闭参考电子表格 oSearchReplaceDoc.close(true)。但由于您很可能想要纠正检测到的错误，因此我们不会这样做

        Exit Sub
    EndIf

让我们收集有关替换范围的必要信息：工作表的名称以及此工作表上命名范围的位置

Dim NamedRange As Variant
Dim oReferredCells As Variant
Dim aRangeAddress As New com.sun.star.table.CellRangeAddress
Dim nStartColumn As Long
Dim nStartRow As Long
Dim nEndRow As Long
Dim sSheetName As String
    NamedRange = oSearchReplaceDoc.NamedRanges.getByName(sSearchReplaceRangeName)

    oReferredCells = NamedRange.getReferredCells()
    aRangeAddress = oReferredCells.getRangeAddress()
    nStartColumn = aRangeAddress.StartColumn
    nStartRow = aRangeAddress.StartRow
    nEndRow = aRangeAddress.EndRow
    sSheetName = oReferredCells.getSpreadsheet().getName()

现在我们可以真正关闭替换电子表格了——我们将以另一种方式访问其数据。

    oSearchReplaceDoc.close(true)

所有进一步的工作仅需使用当前电子表格即可完成oDoc

为了确保辅助附加表的名称不会与已经存在的工作表重名，我们将为其想出一个“几乎随机”的名称：

Dim sTempSheetName As String
    sTempSheetName = sSearchReplaceRangeName & Format(Timer,"0")

让我们确保当前电子表格中没有这样的工作表（如果有，则删除它），并在电子表格末尾创建一个新工作表。使用关联（）方法，将替换列表中的数据复制到其中：

Dim oSheets As Variant
Dim nCount As Long
Dim oTempSheet As Variant
    oSheets = ThisComponent.getSheets()
    If oSheets.hasByName(sTempSheetName) Then oSheets.removeByName(sTempSheetName)
    nCount = oSheets.getCount()
    oSheets.insertNewByName(sTempSheetName, nCount)
    oTempSheet = oSheets.getByIndex(nCount)
    oTempSheet.link(ConvertToURL(sSearchReplaceFilePath), sSheetName, "calc8", "", com.sun.star.sheet.SheetLinkMode.VALUE)

现在已经完成了所有初步检查和设置，实际的搜索和替换非常简单。

Dim nCountReplacements As Long 
Dim nNextSheet As Long 
Dim oNextSheet As Variant
Dim nReplRow As Long 
Dim oSearchDescriptor As Variant
Dim sSearchStr As String 
Dim oFormattedCellAddress As Variant
Dim oFound As Variant
Dim oCell As Variant

对于电子表格中的每个工作表（最后一张工作表除外 - 最后一张工作表是替换列表）创建一个搜索描述符，设置其参数SearchRegularExpression和SearchType（1方法“按值搜索”）

    For nNextSheet = 0 To nCount-1
        oNextSheet = oSheets.getByIndex(nNextSheet)
        oSearchDescriptor = oNextSheet.createSearchDescriptor()
        oSearchDescriptor.SearchRegularExpression = True
        oSearchDescriptor.SearchType = 1

对于替换列表中的每一行，获取搜索字符串并替换单元的地址（参见第章5.23.2. 不使用剪贴板复制电子表格单元格）

        For nReplRow = nStartRow To nEndRow
            sSearchStr = oTempSheet.getCellByPosition(nStartColumn, nReplRow).getString()
            oFormattedCellAddress = oTempSheet.getCellByPosition(nStartColumn+1, nReplRow).getRangeAddress()
            oSearchDescriptor.setSearchString(sSearchStr)
            oFound = oNextSheet.findAll(oSearchDescriptor)

如果成功搜索下一个正则表达式，则遍历所有找到的单元格并将示例单元格复制到其中。同时，我们计算报告中执行的替换次数。

            If Not IsNull(oFound)  Then 
                For Each oCell In oFound.getCells()
                    oTempSheet.copyRange(oCell.getCellAddress(), oFormattedCellAddress)
                    nCountReplacements = nCountReplacements + 1

就这些了。关闭所有检查和循环，移除辅助表，报告工作完成情况：

                Next oCell
            EndIf 
        Next nReplRow
    Next nNextSheet
    If oSheets.hasByName(sTempSheetName) Then oSheets.removeByName(sTempSheetName)
    MsgBox nCountReplacements & " substitutions made", MB_ICONINFORMATION, "Done"
End Sub

希望这对您有帮助

Answer 1