在工作表中查找并选择多个单元格

Question

我是编写宏的新手，并且到处寻找解决我的问题的方法，但没有运气，所以我希望在这里得到一些帮助。

我有一个包含多个自动计算的 Excel 电子表格。这意味着电子表格的很大一部分被锁定给只需要进行计算的其他用户。基本上我想要的是用两种不同的语言制作这个电子表格。因此，我想使用宏将电子表格中的所有文本内容从一种语言更改为另一种语言。因为我只想要一个电子表格（因为我一直在更新它并向它添加新的计算），所以我认为带有按钮的宏可以在两种语言之间切换是最好的解决方案。

这是我的问题。我使用查找和替换来替换每个工作正常的单词。

Sub Rename_EN()
'
ActiveSheet.Unprotect
    Cells.Select
    Selection.Replace What:="rød", Replacement:="red", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="grøn", Replacement:="green", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="blå", Replacement:="blue", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="Flt-tag", Replacement:="FLT-roof", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

 ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub

但文本也有技术术语，fx。我希望将 F_(LT-tag) 替换为 F_(LT-roof)，但将 (LT-roof) 作为下标文本。

我找了半天，得出的结论是不可能对代码中的文字进行简单的下标。 （如果是，那么请随时告诉我如何:)）然后我发现这段代码可以将特定字符更改为下标和上标：

Sub Super_Sub()
Dim NumSub
Dim NumSuper
Dim SubL
Dim SubR
Dim SuperL
Dim SuperR
Dim CheckSub
Dim CounterSub
Dim CheckSuper
Dim CounterSuper
Dim Cell
'
CheckSub = True
CounterSub = 0
CheckSuper = True
CounterSuper = 0
Cell = ActiveCell
'
NumSub = Len(Cell) - Len(Application.WorksheetFunction.Substitute(Cell, "[", ""))
NumSuper = Len(Cell) - Len(Application.WorksheetFunction.Substitute(Cell, "{", ""))
'
If Len(Cell) = 0 Then Exit Sub
If IsError(Application.Find("[", ActiveCell, 1)) = False Then
Do
    Do While CounterSub <= 1000
        SubL = Application.Find("[", ActiveCell, 1)
        SubR = Application.Find("]", ActiveCell, 1)
        ActiveCell.Characters(SubL, 1).Delete
        ActiveCell.Characters(SubR - 1, 1).Delete
        ActiveCell.Characters(SubL, SubR - SubL - 1).Font.Subscript = True
        CounterSub = CounterSub + 1
        If CounterSub = NumSub Then
            CheckSub = False
            Exit Do
        End If
    Loop
Loop Until CheckSub = False
End If
'
'
If IsError(Application.Find("{", ActiveCell, 1)) = False Then
Do
    Do While CounterSuper <= 1000
        SuperL = Application.Find("{", ActiveCell, 1)
        SuperR = Application.Find("}", ActiveCell, 1)
        ActiveCell.Characters(SuperL, 1).Delete
        ActiveCell.Characters(SuperR - 1, 1).Delete
        ActiveCell.Characters(SuperL, SuperR - SuperL - 1).Font.Superscript = True
        CounterSuper = CounterSuper + 1
        If CounterSuper = NumSuper Then
            CheckSuper = False
            Exit Do
        End If
    Loop
Loop Until CheckSuper = False
End If
'
End Sub

所以我想制作一个可以按特定顺序运行宏的按钮。这里的问题是，我需要选择带有 { 和 [ 的单元格来运行代码。

我可以重写此代码以用于整个电子表格吗？我再次搜索解决方案但找不到，所以我尝试在此之前运行另一个宏，它查找并选择包含 { 和 [.我又一次碰壁了，因为我无法让它在整张纸上选择多个单元格。

Answer 1

我能想到的一种方法是在相关单元格中设置第二个隐藏表，其中包含替换文本。然后，您可以使用FIND 查找包含值的所有单元格，检查它不包含公式并将值与第二张表中的值交换。

Sub Test()

    Dim firstAddress As String
    Dim rCell As Range
    Dim sValue As String

    Dim MainSheet As Worksheet
    Dim SecondSheet As Worksheet

    'MainSheet contains your formula & text.
    'SecondSheet only contains values in the text cells.
    With ThisWorkbook
        Set MainSheet = .Worksheets("Sheet1")
        Set SecondSheet = .Worksheets("Sheet2")
    End With

    Set rCell = MainSheet.Cells.Find("*", , xlValues, xlWhole, , xlNext, True)
    If Not rCell Is Nothing Then
        firstAddress = rCell.Address
        Do
            'If the cell doesn't contain a formula swap its value with
            'the value held in the second sheet.
            If Not rCell.HasFormula Then
                sValue = rCell.Value
                rCell.Value = SecondSheet.Range(rCell.Address).Value
                SecondSheet.Range(rCell.Address).Value = sValue
            End If
            Set rCell = MainSheet.Cells.FindNext(rCell)
        Loop While rCell.Address <> firstAddress
    End If

End Sub