由循环通过宏调用的 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

你可以试试这个：

1. 您应该避免依赖.Selection。相反，显式声明一个范围。在这里，范围将是 A 列，从A1到 Col A 中最后使用的行 (LRow(。此范围在代码中引用为CurrentRange。
2. 您需要在With语句中的属性前面加上.
3. 您可以删除Replace中设置为False的选项。如果未说明，它们将默认为False
4. 禁用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