多个工作表与Vlookup到多个工作表macros太长
当我将此macros复制到同一工作簿中的不同工作表时，出现错误。
例如，当我复制此代码的工作表“Class 11”，并通过执行查找将其重命名为“Class 16”，并将其全部从Class 11replace为Class 16，并将其粘贴到vba中，并对所有工作表，所以“16级”，“81级”等我得到一个错误，macros观太长。
我希望macros做相同的事情，但在同一工作簿中的71个工作表的过程中，并做了不同的工作簿中的71工作表的vlookups。
Sub MonthlySKUAudit() ' ' MonthlySKUAudit Macro ' ' 'Class 11' Sheets("Class 11").Select Columns("W:W").Select Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("W1").Select ActiveCell.FormulaR1C1 = "Service Code" Range("W1").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With Range("W2").Formula = "=VLOOKUP(E2,'[Return Disposition Reference.xlsx]ence.xlsx]Class 11'!$D:$AD,13,False)" lastrow = Range("A65536").End(xlUp).Row Range("W2").AutoFill Destination:=Range("W2:W" & lastrow) Columns("W:W").Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Columns("V:W").Select Range("W1").Activate Selection.RowDifferences(ActiveCell).Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 5287936 .TintAndShade = 0 .PatternTintAndShade = 0 End With Range("W1").Select Columns("X:X").Select Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("X1").Select ActiveCell.FormulaR1C1 = "Return Program" Range("X1").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With Range("X2").Formula = "=VLOOKUP(E2,'[Return Disposition Reference.xlsx]ence.xlsx]Class 11'!$D:$AD,4,False)" lastrow = Range("A65536").End(xlUp).Row Range("X2").AutoFill Destination:=Range("X2:X" & lastrow) Columns("X:X").Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Columns("AA:AA").Select Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("AA1").Select ActiveCell.FormulaR1C1 = "Openbox Return" Range("AA1").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With Range("AA2").Formula = "=VLOOKUP(E2,'[Return Disposition Reference.xlsx]ence.xlsx]Class 11'!$D:$AD,9,False)" lastrow = Range("A65536").End(xlUp).Row Range("AA2").AutoFill Destination:=Range("AA2:AA" & lastrow) Columns("AA:AA").Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Columns("AE:AE").Select Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("AE1").Select ActiveCell.FormulaR1C1 = "Func Check" Range("AE1").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With Range("AE2").Formula = "=VLOOKUP(E2,'[Return Disposition Reference.xlsx]ence.xlsx]Class 11'!$D:$AD,10,False)" lastrow = Range("A65536").End(xlUp).Row Range("AE2").AutoFill Destination:=Range("AE2:AE" & lastrow) Columns("AE:AE").Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Columns("AG:AG").Select Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("AG1").Select ActiveCell.FormulaR1C1 = "Serial Number" Range("AG1").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With Range("AG2").Formula = "=VLOOKUP(E2,'[Return Disposition Reference.xlsx]ence.xlsx]Class 11'!$D:$AD,11,False)" lastrow = Range("A65536").End(xlUp).Row Range("AG2").AutoFill Destination:=Range("AG2:AG" & lastrow) Columns("AG:AG").Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Columns("Y:Y").Select Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("Y1").Select ActiveCell.FormulaR1C1 = "Known Restrictions" Range("Y1").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With Range("Y2").Formula = "=VLOOKUP(E2,'[Return Disposition Reference.xlsx]ence.xlsx]Class 11'!$D:$AD,7,False)" lastrow = Range("A65536").End(xlUp).Row Range("Y2").AutoFill Destination:=Range("Y2:Y" & lastrow) Columns("Y:Y").Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Columns("AK:AK").Select Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("AK1").Select ActiveCell.FormulaR1C1 = "Support Factory Warranty" Range("AK1").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With Range("AK2").Formula = "=VLOOKUP(E2,'[Return Disposition Reference.xlsx]ence.xlsx]Class 11'!$D:$AD,15,False)" lastrow = Range("A65536").End(xlUp).Row Range("AK2").AutoFill Destination:=Range("AK2:AK" & lastrow) Columns("AK:AK").Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Columns("AM:AM").Select Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("AM1").Select ActiveCell.FormulaR1C1 = "Service Under Warranty" Range("AM1").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With Range("AM2").Formula = "=VLOOKUP(E2,'[Return Disposition Reference.xlsx]ence.xlsx]Class 11'!$D:$AD,16,False)" lastrow = Range("A65536").End(xlUp).Row Range("AM2").AutoFill Destination:=Range("AM2:AM" & lastrow) Columns("AM:AM").Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Columns("AO:AO").Select Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("AO1").Select ActiveCell.FormulaR1C1 = "Service Outside Warranty" Range("AO1").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With Range("AO2").Formula = "=VLOOKUP(E2,'[Return Disposition Reference.xlsx]ence.xlsx]Class 11'!$D:$AD,17,False)" lastrow = Range("A65536").End(xlUp).Row Range("AO2").AutoFill Destination:=Range("AO2:AO" & lastrow) Columns("AO:AO").Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Columns("AR:AR").Select Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("AR1").Select ActiveCell.FormulaR1C1 = "Resell Indicator" Range("AR1").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With Range("AR2").Formula = "=VLOOKUP(E2,'[Return Disposition Reference.xlsx]ence.xlsx]Class 11'!$D:$AD,21,False)" lastrow = Range("A65536").End(xlUp).Row Range("AR2").AutoFill Destination:=Range("AR2:AR" & lastrow) Columns("AR:AR").Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Columns("AU:AU").Select Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("AU1").Select ActiveCell.FormulaR1C1 = "RTV Defective Days" Range("AU1").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With Range("AU2").Formula = "=VLOOKUP(E2,'[Return Disposition Reference.xlsx]ence.xlsx]Class 11'!$D:$AD,20,False)" lastrow = Range("A65536").End(xlUp).Row Range("AU2").AutoFill Destination:=Range("AU2:AU" & lastrow) Columns("AU:AU").Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Columns("AW:AW").Select Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("AW1").Select ActiveCell.FormulaR1C1 = "RTV Open Box Days" Range("AW1").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With Range("AW2").Formula = "=VLOOKUP(E2,'[Return Disposition Reference.xlsx]ence.xlsx]Class 11'!$D:$AD,19,False)" lastrow = Range("A65536").End(xlUp).Row Range("AW2").AutoFill Destination:=Range("AW2:AW" & lastrow) Columns("AW:AW").Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Columns("AY:AY").Select Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("AY1").Select ActiveCell.FormulaR1C1 = "Open Box Resell" Range("AY1").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With Range("AY2").Formula = "=VLOOKUP(E2,'[Return Disposition Reference.xlsx]ence.xlsx]Class 11'!$D:$AD,22,False)" lastrow = Range("A65536").End(xlUp).Row Range("AY2").AutoFill Destination:=Range("AY2:AY" & lastrow) Columns("AY:AY").Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Columns("BB:BB").Select Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("BB1").Select ActiveCell.FormulaR1C1 = "Liquidation" Range("BB1").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With Range("BB2").Formula = "=VLOOKUP(E2,'[Return Disposition Reference.xlsx]ence.xlsx]Class 11'!$D:$AD,24,False)" lastrow = Range("A65536").End(xlUp).Row Range("BB2").AutoFill Destination:=Range("BB2:BB" & lastrow) Columns("BB:BB").Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Columns("BE:BE").Select Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("BE1").Select ActiveCell.FormulaR1C1 = "Shelf Display to OB Resell" Range("BE1").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With Range("BE2").Formula = "=VLOOKUP(E2,'[Return Disposition Reference.xlsx]ence.xlsx]Class 11'!$D:$AD,23,False)" lastrow = Range("A65536").End(xlUp).Row Range("BE2").AutoFill Destination:=Range("BE2:BE" & lastrow) Columns("BE:BE").Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Columns("AA:AB").Select Range("AB1").Activate Selection.RowDifferences(ActiveCell).Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 5287936 .TintAndShade = 0 .PatternTintAndShade = 0 End With Range("AB1").Select Columns("AE:AF").Select Range("AF1").Activate Selection.RowDifferences(ActiveCell).Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 5287936 .TintAndShade = 0 .PatternTintAndShade = 0 End With Range("AF1").Select Columns("AG:AH").Select Range("AH1").Activate Selection.RowDifferences(ActiveCell).Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 5287936 .TintAndShade = 0 .PatternTintAndShade = 0 End With Range("AH1").Select Columns("AJ:AK").Select Range("AK1").Activate Selection.RowDifferences(ActiveCell).Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 5287936 .TintAndShade = 0 .PatternTintAndShade = 0 End With Range("AK1").Select Columns("AL:AM").Select Range("AM1").Activate Selection.RowDifferences(ActiveCell).Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 5287936 .TintAndShade = 0 .PatternTintAndShade = 0 End With Range("AM1").Select Columns("AN:AO").Select Range("AO1").Activate Selection.RowDifferences(ActiveCell).Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 5287936 .TintAndShade = 0 .PatternTintAndShade = 0 End With Range("AO1").Select Columns("AQ:AR").Select Range("AR1").Activate Selection.RowDifferences(ActiveCell).Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 5287936 .TintAndShade = 0 .PatternTintAndShade = 0 End With Range("AR1").Select Columns("AT:AU").Select Range("AU1").Activate Selection.RowDifferences(ActiveCell).Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 5287936 .TintAndShade = 0 .PatternTintAndShade = 0 End With Range("AU1").Select Columns("AV:AW").Select Range("AW1").Activate Selection.RowDifferences(ActiveCell).Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 5287936 .TintAndShade = 0 .PatternTintAndShade = 0 End With Range("AW1").Select Columns("AX:AY").Select Range("AY1").Activate Selection.RowDifferences(ActiveCell).Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 5287936 .TintAndShade = 0 .PatternTintAndShade = 0 End With Range("AY1").Select Columns("BA:BB").Select Range("BB1").Activate Selection.RowDifferences(ActiveCell).Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 5287936 .TintAndShade = 0 .PatternTintAndShade = 0 End With Range("BB1").Select Columns("BD:BE").Select Range("BE1").Activate Selection.RowDifferences(ActiveCell).Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 5287936 .TintAndShade = 0 .PatternTintAndShade = 0 End With Range("BE1").Select Rows("1:1").Select With Selection .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Columns("AA:AA").Select Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("AA1").Select ActiveCell.FormulaR1C1 = "Returnable" Range("AA1").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With Range("AA2").Formula = "=VLOOKUP(E2,'[Return Disposition Reference.xlsx]ence.xlsx]Class 11'!$D:$AD,8,False)" lastrow = Range("A65536").End(xlUp).Row Range("AA2").AutoFill Destination:=Range("AA2:AA" & lastrow) Columns("AA:AA").Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Columns("Z:AA").Select Range("AA1").Activate Selection.RowDifferences(ActiveCell).Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 5287936 .TintAndShade = 0 .PatternTintAndShade = 0 End With Range("AA1").Select End Sub 当一遍又一遍地做同样的事情时，你想做一个循环。 在这种情况下，我会做一个For Each循环。
你也想避免使用。select。 看到这里如何做到这一点的一个很好的解释。
梳理两个我redid你的代码的第一部分，列W：
Sub monthlyskuaudit() Dim ws As Worksheet Dim lastRow As Long Dim cel As Range Dim diffRng As Range For Each ws In ActiveWorkbook.Sheets With ws lastRow = .Range("A" & .Rows.Count).End(xlUp).Row .Columns("W:W").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove With .Range("W1") .Value = "Service Code" .Interior.Color = 65535 End With For Each cel In .Range("W2:W" & lastRow) cel.Value = ws.Evaluate("=VLOOKUP(E" & cel.Row & ",'V:\Return Disposition Reference\[Return Disposition Reference.xlsx]"& ws.Name & "'!$D:$AD,13,False)") Next cel Set diffRng = .Columns("V:W").RowDifferences(.Range("W1")) diffRng.Interior.Color = 5287936 '... End With Next ws End Sub
这将迭代通过每张表，并反复做同样的事情。 试着自己去做剩下的事情。 如果你遇到一个特定的问题，回来一个更具体的问题。
循环是你的朋友
你有很多连续的过程，其中只有一到三个因素在多达十六个重复命令部分之间有所不同。
构build一个从一个迭代到另一个迭代变化的数组，循环访问数组，每次传递一组新的variables到基本命令中。 这可以通过工作表，工作表上的列甚至单个单元来循环。 通过数组的每个循环的范围由LBound和UBound函数决定。
本质上，我已经把你的冗长的一步一步的过程打破了几个循环。 我还将主要关注的领域分为三个子程序，以使其个别关注。
1. main – 创build要处理的工作表名称的数组，循环遍历名称，将每个名称作为parameter passing到monthlySKUAudit。
2. monthlySKUAudit – 将工作表名称传递给它，并通过循环访问列数组和列特定信息来处理单个工作表。
3. makeLookGood – 将一些冗余的格式化代码移动到一个“助手”子文件中，在这两个用户之间作为参数传入较小的变化。
Sub main() 'main - loop through an array of worksheets and call monthlySKUAudit for each one Dim w As Long, vWSs As Variant 'assign an array of worksheet names vWSs = Array("Class 11", "Class 16", "Class 81") For w = LBound(vWSs) To UBound(vWSs) Call monthlySKUAudit(strWS:=CStr(vWSs(w))) Next w End Sub Sub monthlySKUAudit(strWS As String) 'monthlySKUAudit Macro - column/formula/insert/value and RowDifferences Dim rws As Long Dim c As Long, vCOLs As Variant With Worksheets(strWS) rws = .Cells(Rows.Count, 1).End(xlUp).Row - 1 'form of <numerical column>, <vlookup return column>, <row 1 title> vCOLs = Array(Columns("W:W").Column, 13, "Service Code", _ Columns("X:X").Column, 4, "Return Program", _ Columns("AA:AA").Column, 9, "Openbox Return", _ Columns("AE:AE").Column, 10, "Func Check", _ Columns("AG:AG").Column, 11, "Serial Number", _ Columns("Y:Y").Column, 7, "Known Restrictions", _ Columns("AK:AK").Column, 15, "Support Factory Warranty", _ Columns("AM:AM").Column, 16, "Service Under Warranty", _ Columns("AO:AO").Column, 17, "Service Outside Warranty", _ Columns("AR:AR").Column, 21, "Resell Indicator", _ Columns("AU:AU").Column, 20, "RTV Defective Days", _ Columns("AW:AW").Column, 19, "RTV Open Box Days", _ Columns("AY:AY").Column, 22, "Open Box Resell", _ Columns("BB:BB").Column, 24, "Liquidation", _ Columns("BE:BE").Column, 23, "Shelf Display to OB Resell") 'process the column inserts, yellow fill and row 1 column header labels For c = LBound(vCOLs) To UBound(vCOLs) Step 3 .Columns(vCOLs(c)).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove With .Columns(vCOLs(c)) Call makeLookGood(.Cells(1), 65535, vCOLs(c + 2)) .Cells(2).Resize(rws, 1).Formula = _ "=VLOOKUP(E2, '[Return Disposition Reference.xlsx]" & strWS & "'!$D:$AD, " & vCOLs(c + 1) & ", FALSE)" .Cells(2).Resize(rws, 1) = .Cells(2).Resize(rws, 1).Value End With Next c 'form of <string columns> vCOLs = Array("V:W", "AA:AB", "AE:AF", "AG:AH", "AJ:AK", "AL:AM", _ "AN:AO", "AQ:AR", "AT:AU", "AV:AW", "AX:AY", "BA:BC", _ "BD:BE") 'process all of the RowDifferences highlights For c = LBound(vCOLs) To UBound(vCOLs) With .Columns(vCOLs(c)) Call makeLookGood(.Cells.RowDifferences(.Cells(1, 2)), 5287936) End With Next c 'header row formatting With .Rows("1:1") .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With 'finish the oddball Insert & Formula left at the bottom .Columns("AA:AA").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove With .Columns("AA:AA") Call makeLookGood(.Cells(1), 65535, "Returnable") .Cells(2).Resize(rws, 1).Formula = _ "=VLOOKUP(E2, '[Return Disposition Reference.xlsx]" & strWS & "'!$D:$AD, 8, FALSE)" .Cells(2).Resize(rws, 1) = .Cells(2).Resize(rws, 1).Value End With 'finish the oddball RowDifferences left at the bottom With .Columns("Z:AA") Call makeLookGood(.Cells.RowDifferences(.Cells(1, 2)), 5287936) End With End With End Sub Sub makeLookGood(rng As Range, clr As Long, Optional lbl As Variant = "") 'makeLookGood - interior fill and optional column header label With rng With .Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = clr .TintAndShade = 0 .PatternTintAndShade = 0 End With 'if a column header label was passed in, use it If CBool(Len(CStr(lbl))) Then _ .Cells(1) = lbl End With End Sub
我关心两个领域，但是我没有改变你原来的顺序。 插入列时，最好从右到左工作，以便插入的列不会更改后续列插入的顺序。 您可以从左向右工作，但是您必须小心地补偿在插入列后，您将调整后续工作。
至less在两个地方，你开始在一个方向工作，然后停止和回溯。 由于从未见过实际的数据，所以我无法做出明确的表述，因为您可能不得不为了利用重新计算的数据而回溯，但总的来说，最好从一个方向工作到另一个方向，或者将所有列select基于列标题的相对位置不pipe它们处于什么序位，标签都不会改变。
你的variables声明¹缺乏。 将variables声明为不同的types并为其分配合适的值。
我也完全消除了依赖.Select 2和Activate 2作为引用单元格的方法，同时充分利用With … End With语句来促进工作表/列/单元格的直接引用。 ActiveWorkbook ， ActiveSheet和ActiveCell属性仅仅是引用对象执行工作的不可靠的方法。
总而言之，它并不是一直烧到一小撮代码行，但它肯定比原来的代码更短（而且更加可读）。 另外一个好处是，在中心位置执行一次添加，删除和修改，而不是在几十个几乎完全相同的位置执行。
¹ 在VBE工具中设置需要variables声明 ►选项►编辑器属性页面将把Option Explicit语句放在每个新创build的代码表的顶部。 这将避免像拼写错误这样的愚蠢的编码错误，也会影响你在variables声明中使用正确的variablestypes。 在没有声明的情况下即时创build的variables都是变体/对象types。 使用Option Explicit被广泛认为是“最佳实践”。
² 请参阅如何避免使用在Excel VBAmacros中select更多的方法来摆脱依靠select和激活来实现您的目标。