仅在选定单元格上运行现有宏，而不是整个工作表

Posted 2023-02-24

【中文标题】仅在选定单元格上运行现有宏，而不是整个工作表

【英文标题】：Run existing Macro only on Selected Cells, instead of the whole sheet

【发布时间】：2014-03-13 18:41:23

【问题描述】：

我有以下宏（LibreOffice Calc）：

Sub CalcFindAndReplace
    Dim oDoc,aFind,aReplace,aRayCount,FandR,oSheet
    oDoc = ThisComponent
    aFind = Array("Mecanica","Cancion","Murcielago")
    aReplace = Array("Mecánica","Canción","Murciélago")
    aRayCount = 0
    oSheet = oDoc.getSheets.getByName(oDoc.CurrentSelection.Spreadsheet.Name)
    FandR = oSheet.createReplaceDescriptor
    FandR.SearchCaseSensitive = true
    FandR.SearchWords = true ' 1 to A but not 11 to AA
    FandR.SearchRegularExpression = true

    While aRayCount <= uBound(aFind)
        FandR.setSearchString(aFind(aRayCount))
        FandR.setReplaceString(aReplace(aRayCount))
        aRayCount = aRayCount + 1
        oSheet.ReplaceAll(FandR)
    End While

End Sub

它工作正常，但我需要将其添加为仅适用于手动选择单元格（每次不同）的功能，而不是适用于工作表的所有单元格。

【参考方案1】：

已编辑

以下代码将采用当前选定的单元格，将每个单元格替换为实际的字符串值（注意：可能作用于单元格的 calc 函数将被永久删除），然后将根据需要替换字符串单元格。

受到http://www.oooforum.org/forum/viewtopic.phtml?t=137064 和http://www.oooforum.org/forum/viewtopic.phtml?t=71015 和http://www.oooforum.org/forum/viewtopic.phtml?t=65318 的激励...

Sub ReplaceEachCellWithActualValue()
    ' Gets the current user selection and replace each cell with the actual String value
    Dim oDoc, oSheet, oCell As Object
    oDoc = ThisComponent
    oSheet = oDoc.getSheets.getByName(oDoc.CurrentSelection.Spreadsheet.Name)
    RangeAddress = oDoc.getCurrentSelection.getRangeAddress 

    c1 = RangeAddress.StartColumn
    r1 = RangeAddress.StartRow
    c2 = RangeAddress.EndColumn
    r2 = RangeAddress.EndRow

    for i = c1 to c2
            for j = r1 to r2 
                    Dim cellasstring As String
                    oCell = oSheet.getCellByPosition(i, j)
                    cellasstring = oCell.string
                    oSheet.getCellByPosition(i, j).String = cellasstring
            next j
    next i

End Sub

Sub CalcFindAndReplace

    ' first replace all formulas on the selected cells with actual strings...
    ReplaceEachCellWithActualValue()

    ' Then replace as desired...  
    Dim oDoc,aFind,aReplace,aRayCount,FandR,oSheet        
    oDoc = ThisComponent
    aFind = Array("Mecanica","Cancion","Murcielago")
    aReplace = Array("Mecánica","Canción","Murciélago")
    aRayCount = 0
    oSheet = oDoc.getSheets.getByName(oDoc.CurrentSelection.Spreadsheet.Name)
    FandR = oSheet.createReplaceDescriptor
    FandR.SearchCaseSensitive = true
    FandR.SearchWords = true ' 1 to A but not 11 to AA
    FandR.SearchRegularExpression = true

    Dim oSelection as Object
    oSelection = oDoc.CurrentController.getSelection

    While aRayCount <= uBound(aFind)
        FandR.setSearchString(aFind(aRayCount))
        FandR.setReplaceString(aReplace(aRayCount))
        oSelection.ReplaceAll(FandR) 
        aRayCount = aRayCount + 1
    Wend
End Sub

【讨论】：

它适用于包含文本的单元格，但不适用于内容是公式结果的单元格，这将是我最需要的。

好的，如果您不需要生成该字符串以供将来使用的 calc 函数，则有一种解决方法。检查改进的答案。

工作几乎完美。如果要替换的术语在单元格中单独存在，则它有效。例如：“Mecanica”：它变为“Mecanica”。如果要替换的术语在单元格中带有其他字符，则它不起作用。例如：“Naranja Mecanica 2”：它不会改变。

实际上，您似乎需要从宏内部调用SUBSTITUTE 函数，这可以通过结合上述代码和this post 中的代码来实现。然而，这似乎是一个不同的问题。