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

问题描述 投票:1回答:1

我对编写宏并不陌生,并且到处搜索都可以解决我的问题,但是没有运气,所以我希望在这里寻求帮助。

我有一个包含多个自动计算的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

所以我想创建一个按钮,该按钮将以特定顺序运行宏。这里的问题是,我需要使用{和[选择单元格以运行代码。

我可以重写此代码以用于整个电子表格吗?我再次搜索解决方案,但找不到解决方案,因此我尝试在此之前运行另一个宏,以查找并选择包含{和[的工作表中的所有单元格。再次碰壁是因为我无法在整个工作表中选择多个单元格。

excel vba select replace subscript
1个回答
0
投票

我可以想到的一种方法是在相关单元格中再有一个包含替换文本的隐藏工作表。然后,您可以使用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
© www.soinside.com 2019 - 2024. All rights reserved.