Next Row 的下标超出范围错误答案

【问题标题】：Subscript out of range error at Next RowNext Row 的下标超出范围错误
【发布时间】：2015-05-15 07:25:23
【问题描述】：

Sub ChangeColor()

Dim rCell As Range
Dim FinalRow As Long, x As Long
Dim NextRow As Long

With Sheet1
    For Each rCell In .Range("H2", .Cells(.Rows.Count, 8).End(xlUp)).Cells
        If rCell.Value > Date + 1 Then
            rCell.Interior.Color = vbRed
        ElseIf rCell.Value < Date - 15 Then
            rCell.Interior.Color = vbYellow
        Else
            rCell.Interior.Color = vbGreen
        End If
    Next rCell


 FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
' Loop through each row
For x = 2 To FinalRow
    ' Decide if to copy based on column D

    If ((Cells(x, 8).Interior.Color = vbRed) Or (Cells(x, 8).Interior.Color = vbYellow)) Then

        Cells(x, 1).Resize(1, 33).Copy
        Sheets("Sheet2").Select
        NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
        Cells(NextRow, 1).Select
        ActiveSheet.Paste
        Sheets("Sheet1").Select
     ElseIf ((Cells(x, 8).Interior.Color = vbGreen)) Then
        Cells(x, 1).Resize(1, 33).Copy
        Sheets("Sheet3").Select
        NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
        Cells(NextRow, 1).Select
        ActiveSheet.Paste
        Sheets("Sheet1").Select
    End If
Next x


End With

End Sub

我在下一行的开头收到下标超出范围错误。在这段代码中，我试图使用单元格的突出显示颜色来分隔列表。在 sheet1 中，如果列有红色或黄色，它应该复制到 Sheet2。如果它有绿色则复制到 sheet3。

【问题讨论】：

标签： vba excel

【解决方案1】：

试试这个：

Sub ChangeColor()

Dim rCell As Range, _
    FinalRow As Long, _
    x As Long, _
    NextRow As Long

With Sheets("Sheet1")
    For Each rCell In .Range("H2", .Cells(Rows.Count, "H").End(xlUp)).Cells
        If rCell.Value > Date + 1 Then
            rCell.Interior.Color = vbRed
        ElseIf rCell.Value < Date - 15 Then
            rCell.Interior.Color = vbYellow
        Else
            rCell.Interior.Color = vbGreen
        End If
    Next rCell

    FinalRow = .Cells(Rows.Count, 1).End(xlUp).Row

    'Loop through each row
    For x = 2 To FinalRow
        ' Decide if to copy based on column D
        If ((.Cells(x, 8).Interior.Color = vbRed) Or (.Cells(x, 8).Interior.Color = vbYellow)) Then
            NextRow = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row + 1
            .Cells(x, 1).Resize(1, 33).Copy Destination:=Sheets("Sheet2").Cells(NextRow, 1).Paste

         ElseIf (.Cells(x, 8).Interior.Color = vbGreen) Then
            NextRow = Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp).Row + 1
            .Cells(x, 1).Resize(1, 33).Copy Destination:=Sheets("Sheet3").Cells(NextRow, 1).Paste

        End If
    Next x
End With

End Sub

或者这个

For x = 2 To FinalRow
    ' Decide if to copy based on column D

    If ((Cells(x, 8).Interior.Color = vbRed) Or (Cells(x, 8).Interior.Color = vbYellow)) Then
        Cells(x, 1).Resize(1, 33).Copy
        NextRow = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row + 1
        ActiveSheet.Cells(NextRow, 1).Paste

     ElseIf ((Cells(x, 8).Interior.Color = vbGreen)) Then
        Cells(x, 1).Resize(1, 33).Copy
        NextRow = Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp).Row + 1
        ActiveSheet.Cells(NextRow, 1).Paste

    End If
Next x

Sheets("Sheet1").Select

【讨论】：

即使在使用了你的两个答案之后，我也遇到了与 Subscript out of range 相同的错误
在NextRow= 线上？你确定你有“Sheet1”、“Sheet2”和“Sheet3”吗？因为该行的其余部分不应该给你那种错误，并且 Long 类型覆盖到 2'147'483'647，所以它也不会溢出。
不，下一行的下一步
关于Next x 声明？
顺便说一句，你没有关闭你的With Sheet1，应该是With Sheets("Sheet1")，最后是End With，看看编辑