两岁的宏上突然出现运行时错误'9'

时间:2018-07-31 17:56:38

标签: excel vba excel-vba excel-2010

我在使用宏已有几个月的问题了,几乎没有什么问题。该宏旨在重新格式化excel报表,并将其插入excel中的其他工作簿中。今天,我不断遇到此消息:

runtime error '9': subscript out of range

当我选择“调试”时,它将突出显示以下代码行:

    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear

我不是编码员。我已经使用宏按钮复制了我要缩短任务的操作,但是在外部复制并将错误和突出显示的代码粘贴并粘贴到搜索引擎中,以查看其他人可能尝试过的内容,我不足以对逻辑进行故障排除。该代码始终有效,我没有做任何不同的事情,但是今天它抛出了“ 9”错误。我尝试过的是重命名工作表以匹配代码,因此基本上是“ Sheet1”。我已经复制了上个月的工作表,删除了旧数据,并尝试运行宏。我什至按照谷歌发现的建议对代码进行了调整,一个人遇到了类似的问题,但是我只是创建了一个“ 1004”错误,因为除了隐含的方向之外,我对xlTop和xlDown的逻辑不完全了解。那没有用,所以我回到正题。

这是我的全部宏代码。很简单。

    Sub UserStats()
    '
    ' UserStats Macro
    '
        Application.ScreenUpdating = False 'Doesn't show the macro 
        run on the screen, speeds up program
    '
   Cells.Select
   With Selection
    .VerticalAlignment = xlTop
    .WrapText = True
    .Orientation = 0
    .AddIndent = False
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
   End With
   Columns("A:A").Select
   Selection.Delete Shift:=xlToLeft
   Columns("B:C").Select
   Selection.Delete Shift:=xlToLeft
   Columns("C:D").Select
   Selection.Delete Shift:=xlToLeft
   Columns("D:I").Select
   Selection.Delete Shift:=xlToLeft
   Rows("1:7").Select
   Selection.Delete Shift:=xlUp
   Columns("A:D").Select

     ' SortUserStats Macro
      ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
      ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A1"), _
          SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
          xlSortTextAsNumbers
      With ActiveWorkbook.Worksheets("Sheet1").Sort
          .SetRange Range("A:D")
          .Header = xlNo
          .MatchCase = False
          .Orientation = xlTopToBottom
          .SortMethod = xlPinYin
          .Apply
End With

  ' CopyUserStats Macro
    Cells.Select
    Selection.RowHeight = 12
    Range("A2:D2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy

    Workbooks("User Stats Prep.xlsx").Worksheets(1).Activate
    Cells(Range("A1").End(xlDown).Row + 1, 1).Select
    Selection.Insert Shift:=xlDown
    Cells.Select
    Selection.RowHeight = 12
    Cells(Range("A1").End(xlDown).Row + 1, 1).Select

    Application.CutCopyMode = False

    ActiveWorkbook.Close SaveChanges:=True
    ActiveWorkbook.Close SaveChanges:=False

End Sub

我很感谢任何建议,否则我将逐行添加新的数据复制和粘贴样式。

1 个答案:

答案 0 :(得分:1)

我试图重新编写它,以使其不具有宏记录器通常创建的多余部分。如果此操作无效或工作原理与以前不同,请准确描述出什么地方了/错误

Sub UserStats()
    '
    ' UserStats Macro
    '

    Application.ScreenUpdating = False  'hides screen, speeds up program

    With ActiveWorkbook.Sheets(1)

        'format all sheet1 cells
        With .Cells
            .VerticalAlignment = xlTop
            .WrapText = True
            .Orientation = 0
            .AddIndent = False
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
            .RowHeight = 12
        End With

        'delete A:D, D:I, and 1:7
        .Columns("A:D").Delete Shift:=xlToLeft
        .Columns("D:I").Delete Shift:=xlToLeft
        .Rows("1:7").Delete Shift:=xlUp

        'Sort UserStats
        With .Columns("A:D").Sort

            .SortFields.Clear
            .SortFields.Add _
                key:=Range("A1"), _
                SortOn:=xlSortOnValues, _
                Order:=xlAscending, _
                DataOption:=xlSortTextAsNumbers

            .SetRange Range("A:D")
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply

        End With

        'Copy UserStats
        ActiveWorkbook.Sheets(1).Range(Range("A2:D2"), Range("A2:D2").End(xlDown)).copy
    End With

    With Workbooks("User Stats Prep.xlsx").Worksheets(1)
        .Cells.RowHeight = 12
        .Cells(Range("A1").End(xlDown).row + 1, 1).Insert Shift:=xlDown
    End With

    Workbooks("User Stats Prep.xlsx").Close SaveChanges:=True

    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
    End With

End Sub