下标超出范围

时间:2016-09-05 15:30:51

标签: vba runtime-error

我正在联系,因为在工作系统计算机上,我在基本宏(Excel 2010)Windows操作系统上遇到运行时错误。我家Excel 2010或2016系统上不会出现这些错误。在新文件中执行代码时,我不应该从范围错误中获取下标。

我在自己的电脑上写这些没有任何问题。

Option Explicit

Sub MoveDataOtherSheets()

With Excel.ThisWorkbook.Sheets("Sheet3")
    Dim cell
    For Each cell In .Range(.Cells(2, 1), Cells(.Rows.Count, 1).End(Excel.xlUp))

        If cell(1, 1) = "PERSONAL" Then
            With Excel.ThisWorkbook.Sheets("Sheet4")
                cell.EntireRow.Copy .Cells(.Rows.Count, 1).End(Excel.xlUp)(2, 1)
            End With
        End If

        If cell(1, 1) = "COMPANY" Then
            With Excel.ThisWorkbook.Sheets("Sheet5")
                cell.EntireRow.Copy .Cells(.Rows.Count, 1).End(Excel.xlUp)(2, 1)
            End With
        End If
    Next

End With

End Sub

1 个答案:

答案 0 :(得分:0)

正如我评论的那样,我认为该错误的唯一可能原因是:

  • 您使用的任何工作表名称对于正在运行的宏所在的实际工作簿无效(确切地说是ThisWorkbook

  • Cells语句中For Each cell In .Range(.Cells(2, 1), Cells(.Rows.Count, 1).End(Excel.xlUp))第二次出现的缺失点

    因此,所有其他引用(.Range和。Cells)在最后一个object关键字之后成为With的父级,简单 Cells(.Rows.Count, 1)实际上是指最后一行当前有效的工作表第1列

但我大多写了这个答案,建议你重构代码:

Option Explicit

Sub MoveDataOtherSheets()
    Dim cell As Range, dataRng As Range
    Dim shtName As String

    With Excel.ThisWorkbook
        Set dataRng = SetDataRng(.Worksheets("Sheet3"), 1)

        For Each cell In dataRng
            shtName = GetSheetName(cell)
            If shtName <> "" Then CopyRow cell, .Sheets(shtName)
        Next cell
    End With
End Sub

Sub CopyRow(cell As Range, sht As Worksheet)
    With sht
        cell.EntireRow.Copy .Cells(.Rows.Count, 1).End(Excel.xlUp)(2, 1)
    End With
End Sub

Function SetDataRng(sht As Worksheet, colIndex As Long) As Range
    With sht
        Set SetDataRng = .Range(.Cells(2, colIndex), .Cells(.Rows.Count, colIndex).End(Excel.xlUp))
    End With
End Function

Function GetSheetName(cell As Range) As String
    Select Case cell
        Case "PERSONAL"
            GetSheetName = "Sheet4"

        Case "COMPANY"
            GetSheetName = "Sheet5"

        Case Else
            GetSheetName = ""
    End Select
End Function

采取以下考虑因素:

  • 最好不要嵌套引用相关对象的With

    in

    With Excel.ThisWorkbook.Sheets("Sheet3")
       ...
            With Excel.ThisWorkbook.Sheets("Sheet4")
    

    你正在嵌套两个没有父级的With个对象,因此打破理智的 With“链”就像下面这样:

    With Excel.ThisWorkbook
        With .Sheets("Sheet3")
        ...
        End With
    
        With .Sheets("Sheet4")
        ...
        End With
    End With
    

    我并没有告诉你为什么这个“链条”破坏疯狂因为我很久以前就学会了它但现在不记得了(!),但它与记忆管理

  • 避免将With块放入不使用引用对象的代码

    就像Dim cell

  • 一样
  • 这两个If块显然是互斥的:单元格值不能同时等于“PERSONAL”和“COMPANY”!

    所以正确的If块将是:

    If cell(1, 1) = "PERSONAL" Then
       ....
    ElseIf cell(1, 1) = "COMPANY" Then
       ...
    End If
    

    但是此时我建议您切换到Select Case块结构,这更适合进一步的代码分支(如果比较值更多)和更可读

  • 将特定任务要求到专用函数/子

    是一个很好的编码习惯

    即使这些任务到目前为止简单和短编码也是如此,因为代码总是增长并且很快变得混乱,难以理解和维护

重构原因和重构编码都是我的贡献,很可能会得到改善

但它们可以成为一个很好的起点