VBA脚本工作,现在不是

时间:2013-12-06 20:30:08

标签: excel vba

我为VBA编写了一个非常快速的脚本,它采用了一个电子表格并对其进行了适当的组织。出于某种原因,我刚尝试使用它,并在此循环中得到用户定义的错误:

Dim qu As Long

For j = i To 10 Step -1
    If Cells(j, 10) = "" Then
        qu = j - 1
        Do While Cells(qu, 10) = Cells(qu - 1, 10)
            Cells(qu, 11) = 10
            Cells(qu - 1, 11) = 10
            qu = qu - 1
        Loop
    Cells(j - 1, 11) = 10
    End If
Next j

整个代码如下所示:

Sub PopulateNF()
i = 10

Do While Cells(i, 2) <> ""
 i = i + 1
Loop

For k = 10 To i Step 1
    If Cells(k, 1) <> "" Then
        Cells(k, 10) = ""
    Else
        If InStr(1, Cells(k, 2), "Received") Then
            Cells(k, 10) = -1
        ElseIf InStr(1, Cells(k, 2), "Workflow") Then
            Cells(k, 10) = 0
        ElseIf InStr(1, Cells(k, 2), "Forwarded") Then
            Cells(k, 10) = 1
        ElseIf InStr(1, Cells(k, 2), "Review Response") Then
            Cells(k, 10) = 2
        ElseIf InStr(1, Cells(k, 2), "Responded and Closed") Then
            Cells(k, 10) = 4
        ElseIf InStr(1, Cells(k, 2), "Sent") Then
            Cells(k, 10) = 3
        ElseIf InStr(1, Cells(k, 2), "Sent and Closed") Then
            Cells(k, 10) = 3
        End If
    End If
Next k

Dim qu As Long

For j = i To 10 Step -1
    If Cells(j, 10) = "" Then
        qu = j - 1
        Do While Cells(qu, 10) = Cells(qu - 1, 10)
            Cells(qu, 11) = 10
            Cells(qu - 1, 11) = 10
            qu = qu - 1
        Loop
    Cells(j - 1, 11) = 10
    End If
Next j


For a = i To 10 Step -1
    If Cells(a, 1) <> "" Then
        Cells(a, 11) = 10
    End If
Next a


Const colA      As Long = 11
Dim lngRow      As Long
Dim lngLastRow  As Long

lngLastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
lngRow = 10
Do While lngRow <= lngLastRow
    If Cells(lngRow, colA) = "" Then
        Cells(lngRow, 1).EntireRow.Delete
        lngLastRow = lngLastRow - 1
    Else: lngRow = lngRow + 1
    End If
Loop

d = 10

Do While Cells(d, 2) <> ""
 d = d + 1
Loop

For k = 6 To d Step 1
    If Cells(k, 1) = "" Then
        Cells(k, 1) = Cells(k, 6)
        Cells(k, 6) = ""
        Cells(k, 2) = Cells(k, 7)
        Cells(k, 7) = ""
        Cells(k, 3) = Cells(k - 1, 3)
        Cells(k, 4) = Cells(k - 1, 4)
        Cells(k, 5) = Cells(k - 1, 5)
        Cells(k, 6) = Cells(k - 1, 6)
        Cells(k, 7) = Cells(k - 1, 7)
        Cells(k, 8) = Cells(k - 1, 8)
        Cells(k, 9) = Cells(k - 1, 9)
    End If
Next k

Const colAN      As Long = 1
Dim lngRowN      As Long
Dim lngLastRowN  As Long

lngLastRowN = Cells.SpecialCells(xlCellTypeLastCell).Row
lngRowN = 9
Do While lngRowN <= lngLastRowN
    If Cells(lngRowN, colAN) = "" Then
        Cells(lngRowN, 1).EntireRow.Delete
        lngLastRowN = lngLastRowN - 1
    ElseIf InStr(1, Cells(lngRowN, colAN), "_") Then
        Cells(lngRowN, 1).EntireRow.Delete
        lngLastRowN = lngLastRowN - 1
    Else: lngRowN = lngRowN + 1
    End If
Loop

Range("a9").CurrentRegion.Sort key1:=Range("a9"), order1:=xlAscending, Header:=xlGuess

Range("D:D").NumberFormat = "mm/dd/yyyy"
Range("F:I").NumberFormat = "mm/dd/yyyy"

Range("C:I").HorizontalAlignment = xlCenter
Range("a:a").VerticalAlignment = xlTop

Range("J:K").EntireColumn.Delete

Range("A:J").Font.Color = vbBlack

MsgBox ("Reformatting Complete")

End Sub

非常感谢任何帮助!

1 个答案:

答案 0 :(得分:0)

单步调试代码看起来你的循环不知道在哪里结束。

基本上就行:

Do While Cells(qu, 10) = Cells(qu - 1, 10)

永远不会错,“qu-1”最终会变成负数。

我不确定这是否适用于您的大量代码,但您可以尝试:

Do While qu <> 1

这应该关闭你的循环,同时仍允许你修改循环中的单元格值。