对于VBA中的Next Loop运行错误次数

Question

I have some VBA which creates a summary report based on a worksheet in Excel.

As part of this there is a For... Next loop which sometimes runs the correct number of times and sometimes runs one too few times.

Here's a sample of the code:

For i = 1 To customerCount
    ' Position 0 is the customer name
    customerStatus(i, 0, 0) = customerList(i)
    For j = 1 To statusCount
        ' Fill each count entry with 0, as we don't yet know the numbers at each status
        customerStatus(i, j, 0) = 0
        customerStatus(i, j, 1) = 0
        customerStatus(i, j, 2) = 0
        customerStatus(i, j, 3) = 0
    Next
Next

There's an existing array called customerList (containing a list of customer names in alphabetical order) which here is used to populate another array. At this stage the loop will sometimes run so that the new array gets populated with the full list and sometimes runs so the last entry never gets transferred over.

If I query the variable i after the loop has finished then on occasions where it misses off the last customer it equals customerCount and on occasions where it has the full list of customers it equals customerCount + 1 .

---

Update: To give a bit more info, I'm self-taught in Excel & VBA and this is a report in work.

The worksheet has one line per customer site and each site has two statuses, showing how far along the sales path the customer is for each of the two products. Using named ranges the spreadsheet is set up so that the users can add and remove columns without causing any errors. They can also add new statuses to be selected, which automatically appear in the drop-down on the worksheet.

The report takes each status (how ever many there are) and gives each one a heading. All customers who have at least 1 site at that status are listed along with the number of sites at that status and a total of some figures. The code runs when the user goes to the worksheet holding the report.

Here's the whole code

Sub autoUpdateReport()

' These will be our arrays
Dim statusEntries
Dim customerList
Dim customerStatus

' And now the rest of the variables we'll use
Dim statusCount, customerCount, customerEntries, reportCount As Long
Dim i, j, k As Long
Dim totalSites As Long
Dim PreviousCount As Long
Dim x As Long, y As Long
Dim moveAlong As Long
Dim fCapacity, totalFCapacity As Double
Dim Import, totalImport As Double
Dim Export, totalExport As Double
Dim TempTxt1, TempTxt2 As String
Dim thisEntry As String
Dim startSheet As String
Dim statusColumn, importColumn, exportColumn As String
Dim name As String
Dim custName As String
Dim cell, allEntries As Range

On Error GoTo errorCatcher

    ' The report will fail if the live tab has blank lines in between the data, due to the customercount field not being able to cope with it.
    ' This checks for an error in the customercount field and stops the report early if there is one
    If IsError(Range("customercount")) = True Then
        MsgBox "Report not refreshed. Please remove blank lines on live data tab", vbCritical, "Error"
        Exit Sub
    End If



    ' Set initial values of variables used
    i = 0
    j = 0
    k = 0
    startSheet = ActiveSheet.name

    If startSheet = "Report 1" Then
        name = "One"
        moveAlong = 0
    ElseIf startSheet = "Report 1" Then
        name = "Two"
        moveAlong = 4
    Else
        'If this is started from something other than one of the report sheets we need to exit.
        Exit Sub
    End If

    statusColumn = name & "statuscolumn"
    importColumn = name & "importcolumn"
    exportColumn = name & "exportcolumn"

    ' Hide what we're doing
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    ' Go to the hidden Reporting Data sheet
    Sheets("Reporting Data").Visible = True
    Sheets("Reporting Data").Select

    ' Get number of entries and statuses in the master report
    reportCount = Range("ReportCount")
    statusCount = Range("StatusCount")

    ' Get how many statuses there were last time this was run
    PreviousCount = Range("prevcount")

    ' If the number has changed clear off all but one of the status lines and then fill down the formulas with the counts for each status
    If statusCount <> PreviousCount Then
        Range("StatusStart").Offset(2, 0).Resize(PreviousCount - 1, 7).Select
        Selection.Clear
        Range("StatusStart").Offset(1, 0).Resize(1, 7).Select
        Selection.AutoFill Destination:=Range("StatusStart").Offset(1, 0).Resize(statusCount, 7), Type:=xlFillDefault
    End If

    ' Now create a 2-dimensional array for the statuses, to hold the status name and the number of customers at that status
    ReDim statusEntries(1 To statusCount, 1 To 2)

    ' Fill the status array
    For i = 1 To statusCount
        'Get the Status Name
        statusEntries(i, 1) = Range("StatusStart").Offset(i, 0)
        'Number of customers at this status
        statusEntries(i, 2) = Range("StatusStart").Offset(i, 2)
    Next

    ' Now create a 1-dimensional array to hold a list of customers
    customerCount = Range("CustomerCount")
    ReDim customerList(1 To customerCount)

    ' We fill the array by getting the range of cells on the live sheet holding the customer names and working through it, adding a new entry each time we find a new name
    Set allEntries = Range("Customers")

    i = 1
    For Each cell In allEntries
        thisEntry = cell
        ' This makes sures we've got a list of unique customers but only works on 1-dimensional arrays
        If IsInArray(thisEntry, customerList) = False Then
            customerList(i) = thisEntry
            i = i + 1
        End If
    Next

    ' Let's put the customer list in alphabetical order, to make the final table look better
    For x = LBound(customerList) To UBound(customerList)
        For y = x To UBound(customerList)
            If UCase(customerList(y)) < UCase(customerList(x)) Then
                TempTxt1 = customerList(x)
                TempTxt2 = customerList(y)
                customerList(x) = TempTxt2
                customerList(y) = TempTxt1
            End If
         Next y
    Next x

    ' Now put this list in a 3-dimensional array, so we can store the customer names and status counts in 1 place
    ReDim customerStatus(1 To customerCount, 0 To statusCount, 0 To 3)

    For i = 1 To customerCount
        ' Position 0 is the customer name
        customerStatus(i, 0, 0) = customerList(i)
        For j = 1 To statusCount
            ' Fill each count entry with 0, as we don't yet know the numbers at each status
            customerStatus(i, j, 0) = 0
            customerStatus(i, j, 1) = 0
            customerStatus(i, j, 2) = 0
            customerStatus(i, j, 3) = 0
            counter = counter + 1
        Next
    Next

    ' Now we'll enter the number of entries at each status into our array
    ' This takes a lot of looping round
    For i = 1 To reportCount
        ' For each line on the master sheet we take the name and the stage
        custName = Range("customercolumn").Offset(i, 0)
        Stage = Range(statusColumn).Offset(i, 0)
        fCapacity = Range("GOutputColumn").Offset(i, 0)
        Import = Range(importColumn).Offset(i, 0)
        Export = Range(exportColumn).Offset(i, 0)

        ' Next we'll find where in the array this should be stored
        ' This is skipped if the stage cell was blank
        If Stage <> "" Then

            ' This is done by 1st going through the list of customers
            For j = 1 To customerCount
                ' We check each entry in position 0 to find the name
                If custName = customerStatus(j, 0, 0) Then
                    ' Once we've got that we look for the status name
                    For k = 1 To statusCount
                        If Stage = statusEntries(k, 1) Then
                            ' Position (*, *, 0) is the count of entries at this status
                            customerStatus(j, k, 0) = customerStatus(j, k, 0) + 1
                            customerStatus(j, k, 1) = customerStatus(j, k, 1) + fCapacity
                            customerStatus(j, k, 2) = customerStatus(j, k, 2) + Import
                            customerStatus(j, k, 3) = customerStatus(j, k, 3) + Export
                            Exit For
                        End If
                    Next
                    Exit For
                End If
            Next
        End If
    Next


    ' Go back to the report sheet to update the table
    Sheets(startSheet).Select
    ActiveSheet.Unprotect

    ' First go clear off the existing table
    Range("A:H").Clear


    j = 2
    ' Create a new table by following these steps and looping round for each status.
    ' j needs to be 2 to start the 1st line in the right place
    For i = 1 To statusCount
        ' Reset the variables to zero, to avoid anything being carried over accidentally
        totalSites = 0
        totalFCapacity = 0
        totalImport = 0
        totalExport = 0

        ' Create the headings line for this status
        Range("A" & i + j) = statusEntries(i, 1)
        Range("B" & i + j) = "No. Sites"
        Range("C" & i + j) = "Total F Capacity"
        Range("D" & i + j) = name & " Import"
        Range("E" & i + j) = name & " Export"
        Range("F" & i + j) = "Update"

        Range("A" & i + j & ":F" & i + j).Select
        Selection.Interior.Color = RGB(92, 136, 26)
        Selection.WrapText = True

        With Selection.Font
            .Size = 11
            .Color = RGB(255, 255, 255)
            .Bold = True
        End With

        Range("B" & i + j & ":F" & i + j).Select
        Selection.HorizontalAlignment = xlCenter


        ' Now on the lines below fill in the customers and the numbers
        For k = 1 To customerCount
            If customerStatus(k, i, 0) > 0 Then
                j = j + 1
                Range("A" & i + j) = customerStatus(k, 0, 0)
                Range("B" & i + j) = customerStatus(k, i, 0)
                Range("C" & i + j) = customerStatus(k, i, 1)
                Range("D" & i + j) = customerStatus(k, i, 2)
                Range("E" & i + j) = customerStatus(k, i, 3)
                totalSites = totalSites + customerStatus(k, i, 0)
                totalFCapacity = totalFCapacity + customerStatus(k, i, 1)
                totalImport = totalImport + customerStatus(k, i, 2)
                totalExport = totalExport + customerStatus(k, i, 3)
                Range("A" & i + j & ":F" & i + j).Select
                Selection.Interior.Color = RGB(235, 241, 222)
            End If
        Next

        ' Finally the total line
        j = j + 1
        Range("A" & i + j) = "Total"
        Range("B" & i + j) = totalSites
        Range("C" & i + j) = totalFCapacity
        Range("D" & i + j) = totalImport
        Range("E" & i + j) = totalExport

        Range("A" & i + j & ":E" & i + j).Font.Bold = True
        Range("A" & i + j & ":F" & i + j).Select
        Selection.Interior.Color = RGB(235, 241, 222)
        j = j + 1

        ' If there are more statuses to go loop back up and create the next one
    Next

    Range("C3:E" & i + j - 2).NumberFormat = "0.000"

    ' Put a border round the whole table
    Range("A3:F" & i + j - 2).Borders.LineStyle = xlContinuous

    ' Create our titles
    Range("A1").Select
    Range("A1") = "Development Pipeline " & name & " report"
    With Selection.Font
        .Size = 11
        .Bold = True
    End With
    Range("F1") = "Report updated on " & Now

    ' Update the Previous Count cell with the number of stauses we've just used.
    Range("prevcount") = statusCount

    ' That's the report updated. Now tidy up the main workbook, hiding sheets that shouldn't be seen
    Sheets("Reporting Data").Visible = xlVeryHidden
    Sheets(startSheet).Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Application.EnableEvents = True
    Application.ScreenUpdating = True

    Exit Sub


errorCatcher:
    'If there's an error then set everything back to normal and display an error message
    Sheets("Reporting Data").Visible = xlVeryHidden
    Sheets(startSheet).Select
    ActiveSheet.Protect, DrawingObjects:=True, Contents:=True, Scenarios:=True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    MsgBox "Sorry, there was an error and the report didn't update.", vbCritical, "Error"



End Sub

Answer 1

Build your code around this structure:

Option Explicit

Public Sub TestMe()

    Dim i&, j&, customerCount&, statusCount&, counter&

    Debug.Print "Code should run: "; customerCount * statusCount        

    For i = 1 To customerCount
        For j = 1 To statusCount
            counter = counter + 1
        Next j
    Next i

   Debug.Print "Code runs: "; counter

End Sub

Then you will see how many times it runs and how many times it should run. Most probably the result is the same, unless you do some tricks like:

• reducing the number of the 2 counters in the loop
• changing their type
• exiting the loop
• using goto

Answer 2

The issue obviously is related to the fact that your variables are not declared properly.

If you declare

Dim i, j, k As Long

only k is of type Long , i and j are of type Variant . If no type is specified VBA assumes Variant .

So these lines are exactly the same…

Dim i As Variant, j As Variant, k As Long 'all specified
Dim i, j, k As Long                       'assumes Variant for non specified types i and j

Note that this behavior is very different to VB.NET where the type at the end of a line specifies for every variable in the comma separated list.
But in VBA the type at the end of a line only specifies the last variable!