使用Vlookup到多个工作表的多个工作表宏太长

时间：2016-01-18 17:34:49

标签： excel vba excel-vba

将此宏复制到同一工作簿中的不同工作表时出现错误。

例如，当我复制工作表“Class 11”的代码并通过执行查找将其重命名为“Class 16”并将所有内容从Class 11替换为Class 16并将其粘贴到vba中，并执行此操作所有工作表，所以“Class 16”，“Class 81”等等。我得到一个宏太长的错误。

我想让宏做同样的事情，但在同一工作簿中的71个工作表的过程中，并在不同的工作簿中对超过71个工作表进行vlookup。

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

2 个答案:

答案 0 :(得分：3)

当你一遍又一遍地做同样的事情时，你想做一个循环。在这种情况下，我会进行For Each循环。

您也希望避免使用.Select。有关如何执行此操作的详细说明，请参阅HERE。

梳理两个我重新编写代码的第一部分，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

这会遍历每张纸并反复做同样的事情。尝试自己完成剩下的工作。如果你遇到一个特定问题，请回答一个更具体的问题。

答案 1 :(得分：1)

循环是你的朋友

您有许多顺序流程，其中最多16个重复命令部分中只有一到三个因素不同。

构造一个变量数组，这些变量从一次迭代变为另一次迭代并循环遍历数组，每次传递将一组新变量传递给基本命令。这可以循环通过工作表，工作表上的列甚至单个单元格。通过数组的每个循环的范围由LBound和UBound函数决定。

基本上，我已经将你冗长的，逐步的过程分解为几个循环。我还将主要关注领域划分为三个子程序，以便将它们本地化以供个人关注。

  

  1. main - 创建要处理的工作表名称数组并循环显示名称，将每个名称依次传递给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

我关注两个方面，但我没有改变你原来的顺序。插入列时，最好从右向左工作，以便插入的列不会更改后续列插入的顺序。你可以从左到右工作，但是你必须小心地补偿插入一列后你调整后续工作的事实。

在至少两个地方，您开始朝一个方向工作，然后停下来并回溯。从未见过实际数据我无法做出明确的陈述，因为您可能需要回溯以利用重新计算的数据，但一般来说，最好从一个方向工作到另一个方向，或者根据列标题的相对位置进行所有列选择无论它们处于什么顺序位置都不会改变的标签。

您的变量声明¹缺乏。将变量声明为不同的类型，并为它们分配适当的值。

我还完全取消了您对.Select²和Activate²的依赖，作为一种引用单元格的方法，同时充分利用With ... End With statement来促进直接工作表/列/单元格引用。 ActiveWorkbook，ActiveSheet和ActiveCell属性只是引用对象执行工作的可靠方法。

总而言之，它并没有一直延伸到少数代码行，但它肯定比原始代码更短（而且我的眼睛更可读）。另外一个好处是，添加，删除和修改在中心位置执行一次，而不是在几十个几乎相同的区域中执行。

¹在VBE的工具►选项►编辑器属性页面中设置需要变量声明会将 Option Explicit 语句放在每个新的顶部创建代码表。这将避免像拼写错误这样的错误编码错误以及影响您在变量声明中使用正确的变量类型。在没有声明的情况下即时创建的变量都是变体/对象类型。使用选项明确被广泛认为是“最佳做法”。

²有关远离依赖选择和激活以实现目标的更多方法，请参阅How to avoid using Select in Excel VBA macros。

相关问题
最新问题