繁体   English   中英

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

[英]For Next Loop in VBA running wrong number of times

我有一些VBA,它基于Excel中的工作表创建摘要报告。

作为此操作的一部分,有一个For... Next循环,该循环有时运行正确的次数,有时运行一次太少。

这是代码示例:

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

现有一个名为customerList数组(包含按字母顺序排列的客户名称列表),该数组用于填充另一个数组。 在此阶段,循环有时会运行,以便新数组填充有完整列表,有时会运行,以便最后一个条目永远不会转移过来。

如果我在循环结束后查询变量i ,那么在错过最后一个客户的情况下,它等于customerCount ,在有完整客户列表的情况下,它等于customerCount + 1


更新:要提供更多信息,我是Excel&VBA的自学老师,这是一份工作报告。

该工作表在每个客户站点上都有一行,而每个站点都有两种状态,显示了客户对这两种产品的销售路径的距离。 使用命名范围,可以设置电子表格,以便用户可以添加和删除列而不会引起任何错误。 他们还可以添加要选择的新状态,这些状态将自动显示在工作表的下拉列表中。

该报告采用每个状态(有多少个状态)并给每个标题一个标题。 列出了处于该状态的至少一个站点的所有客户,以及处于该状态的站点数和总数。 当用户转到保存报表的工作表时,代码将运行。

这是整个代码

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

根据以下结构构建代码:

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

然后,您将看到它运行了多少次以及应该运行了多少次。 除非您执行一些技巧,否则结果很可能是相同的:

  • 减少循环中2个计数器的数量
  • 改变他们的类型
  • 退出循环
  • 使用goto

问题显然与变量未正确声明这一事实有关。

如果您声明

Dim i, j, k As Long

只有kLong类型, ijVariant类型。 如果未指定类型,则VBA假定为Variant

所以这些行是完全一样的…

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

请注意,此行为与VB.NET非常不同,在VB.NET中,行末的类型为逗号分隔列表中的每个变量指定。
但是在VBA中,行尾的类型仅指定最后一个变量!

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM