循环通过宏调用的 Excel 2013 宏仅适用于一张工作表

Question

请原谅我在发帖和规则等方面的错误。我在宏和论坛上发帖为零。
在大型数据库中，我需要更改几个名称的颜色。
我在 Microsoft 网页上找到的宏的第一部分。我录制的第二部分。

宏只在一张纸上运行。尽管进行了广泛的搜索，但找不到答案。
请指导，帮助，指正。我提前感谢并感谢您。

Sub ChangeName_DifferentColor_Loop()

    'ChangeName_DifferentColor_Loop
    'Declare Current as a worksheet object variable.

    Dim Current As Worksheet
    'Loop through all of the worksheets in the active workbook.
    For Each Current In Worksheets
        Call ChangeName_DifferentColor_SingleSheet
        ' This line displays the worksheet name in a message box.
        MsgBox Current.Name
    Next
End Sub

-------------------------------
'Insert you Code Here.
Sub ChangeName_DifferentColor_SingleSheet()      '
    ' ChangeName_DifferentColor_SingleSheet Macro
    '
    Columns("A:A").Select
    Range("A1048545").Activate
    With Application.ReplaceFormat.Font
        Strikethrough = False
        Superscript = False
        Subscript = False
        color = 192
        TintAndShade = 0
    End With
    Selection.Replace What:="Mike", Replacement:="Mike", LookAt:=xlPart, _
                      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                      ReplaceFormat:=True
    Selection.Replace What:="Della", Replacement:="Della", LookAt:=xlPart, _
                      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                      ReplaceFormat:=True
    Selection.Replace What:="Ike", Replacement:="Ike", LookAt:=xlPart, _
                      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                      ReplaceFormat:=True
    Selection.Replace What:="Shan", Replacement:="Shan", LookAt:=xlPart, _
                      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                      ReplaceFormat:=True
    With Application.ReplaceFormat.Font
        Strikethrough = False
        Superscript = False
        Subscript = False
        color = 255
        TintAndShade = 0
    End With
    ReplaceFormat:=True
    ActiveWorkbook.Save
    enter code here
End Sub

谢谢你。

Answer 1

你可以试试这个:

你应该避免依赖 .Selection .相反，明确声明一个范围。在这里，范围将是来自 A1 的 A 列到 Col A 中最后使用的行 (LRow)。此范围称为 CurrentRange在代码中。

您需要在 With 中为您的属性添加前缀. 的声明

您可以删除 Replace 中的选项设置为 False .如果没有说明，它们将默认为 False

禁用 ScreenUpdating加快运行时间

Option Explicit

Sub ChangeName_DifferentColor_Loop()

Dim Current As Worksheet
Dim LRow As Long
Dim CurrentRange As Range

Application.ScreenUpdating = False
    For Each Current In Worksheets
        MsgBox Current.Name

        LRow = Current.Range("A" & Current.Rows.Count).End(xlUp).Row
        CurrentRange = Current.Range("A1:A" & LRow)

            With Application.ReplaceFormat.Font
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .Color = 192
                .TintAndShade = 0
            End With

                CurrentRange.Replace What:="Mike", Replacement:="Mike", LookAt:=xlPart, _
                    SearchOrder:=xlByRows, ReplaceFormat:=True
                CurrentRange.Replace What:="Della", Replacement:="Della", LookAt:=xlPart, _
                    ReplaceFormat:=True
                CurrentRange.Replace What:="Ike", Replacement:="Ike", LookAt:=xlPart, _
                    ReplaceFormat:=True
                CurrentRange.Replace What:="Shan", Replacement:="Shan", LookAt:=xlPart, _
                    SearchOrder:=xlByRows, ReplaceFormat:=True

            With Application.ReplaceFormat.Font
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .Color = 255
                .TintAndShade = 0
            End With

    Next Current
Application.ScreenUpdating = True

End Sub