在VBA循环中重置范围变量会导致424错误

时间:2015-10-02 18:06:30

标签: excel vba excel-vba

所以我知道我昨天问了一个非常相似的问题,它实际上是关于相同的代码。可以找到前一个问题here.

它完成了99%,但是循环中的运行时错误导致它失败。我不明白的是,它运行一次,完成所需的一切,然后重置范围变量YTD使其停止在YTD.Formula = YTDs。代码如下。

    Sub offset(rows1 As Long)
    Dim sh As Worksheet
    'Integers
    Dim i As Long
    Dim k As Long
    'Movers
    Dim current As Range
    Dim first As Range
    'Metrics
    Dim QTRA As Range
    Dim YTD As Range
    Dim yr1 As Range
    Dim yr3 As Range
    Dim yr7 As Range
    Dim yr5 As Range
    Dim yr10 As Range
    Dim SI As Range
    Dim QTR As Range
    Dim YTD_2 As Range
    Dim yr1_2 As Range
    Dim yr3_2 As Range
    Dim yr5_2 As Range
    Dim yr7_2 As Range
    Dim yr10_2 As Range
    Dim SI_2 As Range
    'Strings
    Dim QTRAs As String
    Dim YTDs As String
    Dim yr1s As String
    Dim yr3s As String
    Dim yr7s As String
    Dim yr5s As String
    Dim yr10s As String
    Dim SIs As String
    Dim QTRs As String
    Dim YTD_2s As String
    Dim yr1_2s As String
    Dim yr3_2s As String
    Dim yr5_2s As String
    Dim yr7_2s As String
    Dim yr10_2s As String
    Dim SI_2s As String

    'Puts in the metric names on the top row. Can be adjusted for 2nd row if need be
    Sheets("Comparative Performance1").Range("T1").Formula = "YTD"
    Sheets("Comparative Performance1").Range("U1").Formula = "yr1"
    Sheets("Comparative Performance1").Range("V1").Formula = "yr3"
    Sheets("Comparative Performance1").Range("W1").Formula = "yr5"
    Sheets("Comparative Performance1").Range("Y1").Formula = "yr7"
    Sheets("Comparative Performance1").Range("X1").Formula = "yr10"
    Sheets("Comparative Performance1").Range("Z1").Formula = "SI"
    Sheets("Comparative Performance1").Range("AA1").Formula = "QTR"
    Sheets("Comparative Performance1").Range("AB1").Formula = "YTD_2"
    Sheets("Comparative Performance1").Range("AC1").Formula = "yr1"
    Sheets("Comparative Performance1").Range("AD1").Formula = "yr3"
    Sheets("Comparative Performance1").Range("AE1").Formula = "yr5"
    Sheets("Comparative Performance1").Range("AF1").Formula = "yr7"
    Sheets("Comparative Performance1").Range("AG1").Formula = "yr10"
    Sheets("Comparative Performance1").Range("AH1").Formula = "SI"

    'Finds the length of the data
    'Dim rn As Range
    'Set sh = ThisWorkbook.Sheets("Comparative Performance1")
    'Set rn = sh.UsedRange
    'k = rn.Rows.Count + rn.Row - 1
    k = rows1

    For i = 3 To k
        'Setting vari ables for each respective data column
        Set current = Sheets("Comparative Performance1").Range("J" & i)
        Set first = Sheets("Comparative Performance1").Range("B" & i)
        Set QTRA = Sheets("Comparative Performance1").Range("S" & i)
        Set YTD = Sheets("Comparative Performance1").Range("T" & i)
        Set yr1 = Sheets("Comparative Performance1").Range("U" & i)
        Set yr3 = Sheets("Comparative Performance1").Range("V" & i)
        Set yr5 = Sheets("Comparative Performance1").Range("W" & i)
        Set yr7 = Sheets("Comparative Performance1").Range("Y" & i)
        Set yr10 = Sheets("Comparative Performance1").Range("X" & i)
        Set SI = Sheets("Comparative Performance1").Range("Z" & i)
        Set QTR = Sheets("Comparative Performance1").Range("AA" & i)
        Set YTD_2 = Sheets("Comparative Performance1").Range("AB" & i)
        Set yr1_2 = Sheets("Comparative Performance1").Range("AC" & i)
        Set yr3_2 = Sheets("Comparative Performance1").Range("AD" & i)
        Set yr5_2 = Sheets("Comparative Performance1").Range("AE" & i)
        Set yr7_2 = Sheets("Comparative Performance1").Range("AF" & i)
        Set yr10_2 = Sheets("Comparative Performance1").Range("AG" & i)
        Set SI_2 = Sheets("Comparative Performance1").Range("AH" & i)
        'Moves the benchmarks if it is missing a creation date
        If current = "" Then
            Range(first, current).Select
            Selection.Copy
            Range(first, current).offset(-1, 9).Select
            ActiveSheet.Paste
            'I have it deleting the entire row, which may remove necessary data, not sure yet
            rows(i).EntireRow.Delete
        End If
        'First we have to create strings for all of the formulas using the variable i
        YTDs = "=C" + CStr(i) + "-L" + CStr(i)
        yr1s = "=D" + CStr(i) + "-M" + CStr(i)
        yr3s = "=E" + CStr(i) + "-N" + CStr(i)
        yr5s = "=F" + CStr(i) + "-O" + CStr(i)
        yr7s = "=G" + CStr(i) + "-P" + CStr(i)
        yr10s = "=H" + CStr(i) + "-Q" + CStr(i)
        SIs = "=I" + CStr(i) + "-R" + CStr(i)
        QTRs = "=S" + CStr(i) + "/B" + CStr(i)
        YTD_2s = "=S" + CStr(i) + "/B" + CStr(i)
        yr1_2s = "=U" + CStr(i) + "/D" + CStr(i)
        yr3_2s = "=V" + CStr(i) + "/E" + CStr(i)
        yr5_2s = "=W" + CStr(i) + "/F" + CStr(i)
        yr7_2s = "=X" + CStr(i) + "/G" + CStr(i)
        yr10_2s = "=Y" + CStr(i) + "/H" + CStr(i)
        SI_2s = "=Z" + CStr(i) + "/I" + CStr(i)
        'This should assign all of the metrics using the correct variables
        YTD.Formula = YTDs ********** THIS IS WHERE IT FAILS ************
        yr1.Formula = yr1s
        yr3.Formula = yr3s
        yr5.Formula = yr5s
        yr7.Formula = yr7s
        yr10.Formula = yr10s
        SI.Formula = SIs
        QTR.Formula = QTRs
        YTD_2.Formula = YTD_2s
        yr1_2.Formula = yr1_2s
        yr3_2.Formula = yr3_2s
        yr5_2.Formula = yr5_2s
        yr7_2.Formula = yr7_2s
        yr10_2.Formula = yr10_2s
        SI_2.Formula = SI_2s
    Next i
End Sub

2 个答案:

答案 0 :(得分:1)

我认为您的问题可能出现在If的{​​{1}}声明中。您基本上删除了Rows(i).entirerow.delete以及分配给YTD的范围,该范围等于Row(i)。你需要

  1. 在为变量赋值之前删除行

  2. 删除行后添加以下内容:

    Range("T"& i )'这将重新删除您删除的行

    i=i-1'这将带您回到顶部。

  3. 执行一些错误处理,在遇到该错误后返回到顶部。

答案 1 :(得分:0)

如果删除FOR语句中的行,如果最终出现行差异,则会在每次传递时增加,这会遇到问题。

以下代码对您有用......

Sub Offset(Optional rows1 As Long)
    Dim sh As Worksheet: Set sh = Sheets("Comparative Performance1")

    Dim HeaderRow As Long: HeaderRow = 1
    Dim LastRow As Long: LastRow = sh.Cells.Find("*", _
        SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
    If rows1 > HeaderRow Then LastRow = rows1

    Dim i As Long, k As Long, Counter As Long: Counter = 0

    With sh
        'Puts in the metric names on the top row. Can be adjusted for 2nd row if need be
        Dim Headers() As String: Headers = _
            Split("YTD,yr1,yr3,yr5,yr7,yr10,SI,QTR,YTD_2,yr1,yr3,yr5,yr7,yr10,SI", ",")
        For i = 0 To UBound(Headers)
            .Cells(HeaderRow, 20 + i) = Headers(i) 'Starts at Col T
        Next i

        For i = LastRow To HeaderRow + 2 Step -1
            If .Cells(i, 10).Value = "" Then
                .Range(.Cells(i, 2), .Cells(i, 10)).Copy
                .Range(.Cells(i, 2), .Cells(i, 10)).Offset(-1, 9).PasteSpecial xlPasteValues
                .Rows(i).EntireRow.Delete
                Counter = Counter + 1
            End If
        Next i

        For i = HeaderRow + 2 To LastRow - Counter
            For k = 1 To 7 'Metrics on YTD to SI
                .Cells(i, k + 19).FormulaR1C1 = "=RC[-17]-RC[-8]"
                .Cells(i, k + 27).FormulaR1C1 = "=RC[-8]/RC[-25]"
            Next k
            .Cells(i, 27).FormulaR1C1 = "=RC[-8]/RC[-25]" 'Metric on QTR
        Next i

    End With
End Sub

哦 - 我还假设您在以下行中出错:

YTD_2s = "=S" + CStr(i) + "/B" + CStr(i)

我猜它实际上应该是:

YTD_2s = "=T" + CStr(i) + "/C" + CStr(i)