通过现有宏中的列创建循环＆amp;从主宏调用

时间：2015-08-27 15:00:05

标签： excel vba excel-vba

我在改进代码

后编辑了我以前的帖子

下面包含的原始（杂乱）代码供参考。执行以下任务。

  1. 在我的表格的B列中设置条件格式。
  2. 对表格中每一列进行格式绘制。
  3. 过滤每列中的格式化单元格，并将文本颜色变为红色。
  4. 将包含红色文字的所有单元格替换为“*”。

    5. 原始代码 

    Sub FabricationClearConDups()
'
' Currently this Sub will highlight all consecutive duplicates in all rows
' then format all duplicates with red text colour.

With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With

'Select first row (B) and set conditional format.
    Range("Fabrication_Table[Fab01_Vision02.WidthReagentStripMaSideAvg]").Select
        Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=OR(B2=B1,B2=B3)"
        Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority

    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False

'Format Paint the formula across all rows in Fab Worksheet
Selection.Copy
    Range("C2").Select
                Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
    Range("D2").Select
                Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
    Range("E2").Select
                Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
    Range("F2").Select
                Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
    Range("G2").Select
                Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
    Range("H2").Select
                Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
    Range("I2").Select
                Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
    Range("J2").Select
                Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
    Range("K2").Select
                Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
    Range("L2").Select
                Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
    Range("M2").Select
                Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
    Range("N2").Select
                Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
    Range("O2").Select
                Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
    Range("P2").Select
                Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
    Range("Q2").Select
                Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

'Change actual cell format to Red Text
    Range("Fabrication_Table[Fab01_Vision02.WidthReagentStripMaSideAvg]").Select
        ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=2, _
        Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
            With Selection.Font
                 .Color = -16776961
                 .TintAndShade = 0
            End With
        ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=2

    Range("Fabrication_Table[Fab01_Vision02.WidthReagentStripOpSideAvg]").Select
        ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=3, _
        Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
            With Selection.Font
                 .Color = -16776961
                 .TintAndShade = 0
            End With
        ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=3

     Range("Fabrication_Table[Fab01_Vision02.PositionReagentStripMaSideAvg]").Select
        ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=4, _
        Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
            With Selection.Font
                 .Color = -16776961
                 .TintAndShade = 0
            End With
        ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=4

        Range("Fabrication_Table[Fab01_Vision02.MSEdgeToOSStripeAvg]").Select
        ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=5, _
        Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
            With Selection.Font
                 .Color = -16776961
                 .TintAndShade = 0
            End With
        ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=5

        Range("Fabrication_Table[Fab01_Vision03.SpacerRegistrationToPdMaAvg]").Select
        ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=6, _
        Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
            With Selection.Font
                 .Color = -16776961
                 .TintAndShade = 0
            End With
        ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=6

        Range("Fabrication_Table[Fab01_Vision03.SpacerRegistrationToPdOpAvg]").Select
        ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=7, _
        Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
            With Selection.Font
                 .Color = -16776961
                 .TintAndShade = 0
            End With
        ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=7

        Range("Fabrication_Table[Fab01_Vision06.LaminatedCavityWidthMaSideAvg]").Select
        ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=8, _
        Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
            With Selection.Font
                 .Color = -16776961
                 .TintAndShade = 0
            End With
        ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=8

        Range("Fabrication_Table[Fab01_Vision06.LaminatedCavityWidthOpSideAvg]").Select
        ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=9, _
        Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
            With Selection.Font
                 .Color = -16776961
                 .TintAndShade = 0
            End With
        ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=9

        Range("Fabrication_Table[Fab02_Vision02.WidthReagentStripMaSideAvg]").Select
        ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=10, _
        Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
            With Selection.Font
                 .Color = -16776961
                 .TintAndShade = 0
            End With
        ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=10

        Range("Fabrication_Table[Fab02_Vision02.WidthReagentStripOpSideAvg]").Select
        ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=11, _
        Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
            With Selection.Font
                 .Color = -16776961
                 .TintAndShade = 0
            End With
        ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=11

                Range("Fabrication_Table[Fab02_Vision02.PositionReagentStripMaSideAvg]").Select
        ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=12, _
        Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
            With Selection.Font
                 .Color = -16776961
                 .TintAndShade = 0
            End With
        ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=12

                Range("Fabrication_Table[Fab02_Vision02.MSEdgeToOSStripeAvg]").Select
        ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=13, _
        Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
            With Selection.Font
                 .Color = -16776961
                 .TintAndShade = 0
            End With
        ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=13

                Range("Fabrication_Table[Fab02_Vision03.SpacerRegistrationToPdMaAvg]").Select
        ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=14, _
        Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
            With Selection.Font
                 .Color = -16776961
                 .TintAndShade = 0
            End With
        ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=14

                Range("Fabrication_Table[Fab02_Vision03.SpacerRegistrationToPdOpAvg]").Select
        ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=15, _
        Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
            With Selection.Font
                 .Color = -16776961
                 .TintAndShade = 0
            End With
        ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=15

                Range("Fabrication_Table[Fab02_Vision06.LaminatedCavityWidthMaSideAvg]").Select
        ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=16, _
        Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
            With Selection.Font
                 .Color = -16776961
                 .TintAndShade = 0
            End With
        ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=16

                Range("Fabrication_Table[Fab02_Vision06.LaminatedCavityWidthOpSideAvg]").Select
        ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=17, _
        Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
            With Selection.Font
                 .Color = -16776961
                 .TintAndShade = 0
            End With
        ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=17

'Find red formatted text and replace all with *
    With Application.FindFormat.Font
        .Subscript = False
        .Color = 255
        .TintAndShade = 0
    End With

    Cells.Replace What:="", Replacement:="*", LookAt:=xlPart, SearchOrder:= _
        xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=False

With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With

End Sub

    我已经通过取出所有.Select函数来编辑代码并显着减少了长度。我还删除了步骤4的替换功能。步骤3现在可以更快地执行该工作。如下 - 

    Sub FabricationClearConDups()

'This Sub will convert all Consecutive Duplicate values within all columns to an "*"

With Application
     .ScreenUpdating = False
     .EnableEvents = False
     .Calculation = xlCalculationManual
End With

'Set conditional format on first data row (B)
With Range("Fabrication_Table[Fab01_Vision02.WidthReagentStripMaSideAvg]")
     .FormatConditions.Add Type:=xlExpression, Formula1:="=OR(B2=B1,B2=B3)"
     .FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With .FormatConditions(1).Interior
         .Color = 65535
    End With
End With

'Copy the conditional formatting over to all columns
Range("Fabrication_Table[Fab01_Vision02.WidthReagentStripMaSideAvg]").Copy
 Range("C2").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 Range("D2").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 Range("E2").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 Range("F2").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 Range("G2").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 Range("H2").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 Range("I2").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 Range("J2").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 Range("K2").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 Range("L2").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 Range("M2").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 Range("N2").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 Range("O2").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 Range("P2").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 Range("Q2").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False


'Replace value in all formatted cells with *
    With Range("Fabrication_Table[Fab01_Vision02.WidthReagentStripMaSideAvg]")
         .AutoFilter Field:=2, Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
        With Range("Fabrication_Table[Fab01_Vision02.WidthReagentStripMaSideAvg]")
             .Value = "*"
        End With
    End With
    ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=2

    With Range("Fabrication_Table[Fab01_Vision02.WidthReagentStripOpSideAvg]")
         .AutoFilter Field:=3, Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
        With Range("Fabrication_Table[Fab01_Vision02.WidthReagentStripOpSideAvg]")
             .Value = "*"
        End With
    End With
    ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=3

    With Range("Fabrication_Table[Fab01_Vision02.PositionReagentStripMaSideAvg]")
         .AutoFilter Field:=4, Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
        With Range("Fabrication_Table[Fab01_Vision02.PositionReagentStripMaSideAvg]")
             .Value = "*"
        End With
    End With
    ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=4

    With Range("Fabrication_Table[Fab01_Vision02.MSEdgeToOSStripeAvg]")
         .AutoFilter Field:=5, Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
        With Range("Fabrication_Table[Fab01_Vision02.MSEdgeToOSStripeAvg]")
             .Value = "*"
        End With
    End With
    ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=5

    With Range("Fabrication_Table[Fab01_Vision03.SpacerRegistrationToPdMaAvg]")
         .AutoFilter Field:=6, Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
        With Range("Fabrication_Table[Fab01_Vision03.SpacerRegistrationToPdMaAvg]")
             .Value = "*"
        End With
    End With
    ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=6

    With Range("Fabrication_Table[Fab01_Vision03.SpacerRegistrationToPdOpAvg]")
         .AutoFilter Field:=7, Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
        With Range("Fabrication_Table[Fab01_Vision03.SpacerRegistrationToPdOpAvg]")
             .Value = "*"
        End With
    End With
    ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=7

    With Range("Fabrication_Table[Fab01_Vision06.LaminatedCavityWidthMaSideAvg]")
         .AutoFilter Field:=8, Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
        With Range("Fabrication_Table[Fab01_Vision06.LaminatedCavityWidthMaSideAvg]")
             .Value = "*"
        End With
    End With
    ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=8

    With Range("Fabrication_Table[Fab01_Vision06.LaminatedCavityWidthOpSideAvg]")
         .AutoFilter Field:=9, Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
        With Range("Fabrication_Table[Fab01_Vision06.LaminatedCavityWidthOpSideAvg]")
             .Value = "*"
        End With
    End With
    ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=9

    With Range("Fabrication_Table[Fab02_Vision02.WidthReagentStripMaSideAvg]")
         .AutoFilter Field:=10, Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
        With Range("Fabrication_Table[Fab02_Vision02.WidthReagentStripMaSideAvg]")
             .Value = "*"
        End With
    End With
    ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=10

    With Range("Fabrication_Table[Fab02_Vision02.WidthReagentStripOpSideAvg]")
         .AutoFilter Field:=11, Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
        With Range("Fabrication_Table[Fab02_Vision02.WidthReagentStripOpSideAvg]")
             .Value = "*"
        End With
    End With
    ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=11

    With Range("Fabrication_Table[Fab02_Vision02.PositionReagentStripMaSideAvg]")
         .AutoFilter Field:=12, Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
        With Range("Fabrication_Table[Fab02_Vision02.PositionReagentStripMaSideAvg]")
             .Value = "*"
        End With
    End With
    ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=12

    With Range("Fabrication_Table[Fab02_Vision02.MSEdgeToOSStripeAvg]")
         .AutoFilter Field:=13, Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
        With Range("Fabrication_Table[Fab02_Vision02.MSEdgeToOSStripeAvg]")
             .Value = "*"
        End With
    End With
    ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=13

    With Range("Fabrication_Table[Fab02_Vision03.SpacerRegistrationToPdMaAvg]")
         .AutoFilter Field:=14, Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
        With Range("Fabrication_Table[Fab02_Vision03.SpacerRegistrationToPdMaAvg]")
             .Value = "*"
        End With
    End With
    ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=14

    With Range("Fabrication_Table[Fab02_Vision03.SpacerRegistrationToPdOpAvg]")
         .AutoFilter Field:=15, Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
        With Range("Fabrication_Table[Fab02_Vision03.SpacerRegistrationToPdOpAvg]")
             .Value = "*"
        End With
    End With
    ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=15

    With Range("Fabrication_Table[Fab02_Vision06.LaminatedCavityWidthMaSideAvg]")
         .AutoFilter Field:=16, Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
        With Range("Fabrication_Table[Fab02_Vision06.LaminatedCavityWidthMaSideAvg]")
             .Value = "*"
        End With
    End With
    ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=16

    With Range("Fabrication_Table[Fab02_Vision06.LaminatedCavityWidthOpSideAvg]")
        .AutoFilter Field:=17, Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
        With Range("Fabrication_Table[Fab02_Vision06.LaminatedCavityWidthOpSideAvg]")
             .Value = "*"
        End With
    End With
    ActiveSheet.ListObjects("Fabrication_Table").Range.AutoFilter Field:=17

With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With

End Sub

    正如您所看到的，它仍然非常冗长，但它比以前更快。

    我只有两个问题，按重要性排列 -

    1. 我想在我的主宏中调用这个宏（加上另一个类似的宏），但无法让它工作。

      2. 这是我试过的 - 

      'Call subs for replacing Consecutive Duplicates
With Destwb
Worksheets("Fabrication").Activate
FabricationClearConDups
Worksheets("Kinematics").Activate
KinematicsClearConDups
End With

      但后来我收到以下错误 - “运行时错误'1004 MS Excel无法找到要替换的任何数据。检查您的搜索条件是否正确定义......等等”

      调试突出显示此行 - 

      Range("Fabrication_Table[Fab01_Vision02.WidthReagentStripMaSideAvg]").Select

      我尝试了几种不同的方式来调用它，但无法让它工作。有什么想法吗？

      1. 你会看到我在两个部分中为表格中的每一列重复了相同的代码行。有没有办法用循环来清理东西？可能使用通用标签，以便它可以应用于具有不同列数和不同标题的第二张表...

        2. 我希望这个编辑改进了我的问题，我的查询更加清晰。

        Excel 2010，Windows 7。

1 个答案:

答案 0 :(得分：2)

我有个坏消息。如果您无法理解宏录制器的功能是否足以自行重写，那么您需要聘请某人为您编写宏。

将您的功能拆分为不连续的步骤 记录1步。
看看宏录音机吐出的内容 试着去理解它在做什么 自己重新写一下，以便更清洁 冲洗并重复（这个一般过程是调用重构）。

E.G。如果我用绿色记录填充单元格，我得到：

Range("A1").Select
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .Color = 5296274
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With

我可以重构：

Range("A1").Interior.Color = 5296274 '/ I don't need all those other options

这样做够了

a）您的代码将更容易阅读并弄清楚发生了什么和 b）您将更多地了解如何编写VBA代码的工作方式 c）允许你自己直接编写代码和
d）导致你有一个你理解的代码，因此可以问一个问题，“我需要在VBA中做特定的事情。我该怎么做？”

相关问题
最新问题