簡體   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