Question

请原谅我在发布和规则等方面的错误。我在Macro和论坛上发布时为零。在大型数据库中，我需要更改几个名称的颜色。我在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到Col A中最后使用的行（LRow）的A列。该范围在代码中称为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

通过循环调用的Excel 2013宏只能在一张图纸上使用

1 个答案: