在现有macros中创build循环并从主macros调用

我改进了我的代码后编辑了我以前的post

原始(凌乱)代码包括在下面供参考。 执行以下任务。

  1. 在我的表的B列中设置条件格式。
  2. 在表格中的每个列上格式化绘画。
  3. 在每列中过滤格式化的单元格,并将文本颜色变为红色。
  4. 用“*”replace包含红色文本的所有单元格。

原始代码

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函数来编辑代码,并且显着减less了长度。 我也删除了步骤4的replacefunction。步骤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. 我想在我的主macros中调用这个macros(加上另一个类似的macros),但不能得到它的工作。

这是我试过的 –

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

但是,然后我得到以下错误 – “运行时错误”1004 MS Excel找不到任何数据来replace检查您的search条件是否正确定义…等“

debugging突出了这一行 –

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

我已经尝试了几种不同的方式来调用它,但不能得到它的工作。 有任何想法吗?

  1. 您将在两部分中看到,我只是重复了表中每列的相同代码行。 有什么办法可以使用循环来清理东西吗? 可能使用通用标签,以便可以将其应用于具有不同数量的列和不同标题的第二个工作表。

我希望这个编辑改进了我的问题,我的查询更清晰。

Excel 2010,Windows 7。

我有个坏消息给你。 如果你不明白macroslogging器是否足够自己重写,那么你需要雇用一些人为你写macros。

将你的function分成不同的步骤。
logging1步。
看看macroslogging器吐出了什么。
尝试并理解它在做什么。
重新写自己要更干净。
冲洗并重复(这个一般过程是调用重构)。

如果我logging填充一个绿色的单元格,我得到:

 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中做特定的事情 ,我该怎么做?