VBA分区统计非零单元格异常：top变量未更新问题求助

Let's break down why your top variable is stuck at 2 and fix the logic to correctly count non-zero cells in each partition:

Root Cause of the Issue #

1. No reset for top variable: You declared top outside the outer loop, so once it's set to 2 on the first iteration, it never gets reset for subsequent partitions.
2. Inefficient & incorrect row search: Your inner loop starts at row 1 every time, and the IsEmpty(wbkCurBook.Sheets("August FMR").Cells(i + 1, "G").Value) condition means the code only runs once per partition (after that, the G column has a value, so it skips). This prevents finding the correct starting row for later partitions.
3. Unnecessary full-range scan: Scanning from row 1 to i for every "CASE TOTAL" is slow on 4000 rows—we only need to find the most recent "CSE" row above the current "CASE TOTAL".

Corrected VBA Code #

Dim top As Integer
Dim bot As Integer
Dim n As Integer
Dim Copyrange As String
Dim ws As Worksheet ' Add worksheet variable for cleaner code

Set ws = wbkCurBook.Sheets("August FMR") ' Assign once to avoid repeated references

For i = 2 To LastRow
    If ws.Cells(i, "B").Value = "CASE TOTAL" Then
        ws.Cells(i + 1, "F").Value = "OPEN LINE ITEMS"
        bot = i - 1 ' End of the current partition is always one row above CASE TOTAL
        
        ' Reset top for each new partition
        top = 0
        
        ' Search BACKWARDS from row i to find the nearest "CSE" (start of the partition)
        For t = i - 1 To 1 Step -1
            If ws.Cells(t, "B").Value = "CSE" Then
                top = t + 1 ' Start row is one below CSE
                Exit For ' Stop searching once we find the closest CSE
            End If
        Next t
        
        ' Only calculate if we found a valid top row
        If top > 0 Then
            Copyrange = "J" & top & ":" & "K" & bot
            n = Application.WorksheetFunction.CountIf(ws.Range(Copyrange), ">" & 0)
            ws.Cells(i + 1, "G").Value = n
        End If
    End If
Next i

Key Improvements #

• Worksheet variable: Set ws = ... makes the code cleaner and faster by avoiding repeated references to the worksheet.
• Backward search: Instead of scanning from row 1, we start just above "CASE TOTAL" and move up—this finds the correct starting row for each partition instantly and cuts down on unnecessary loops.
• Reset top: We set top = 0 at the start of each partition processing, ensuring we don't carry over values from previous partitions.
• Validation check: The If top > 0 condition prevents errors if no "CSE" is found for a partition.

Even More Efficient Version (Using Find) #

For larger datasets, using Excel's Find method is faster than looping:

Dim top As Integer
Dim bot As Integer
Dim n As Integer
Dim Copyrange As String
Dim ws As Worksheet
Dim cseCell As Range

Set ws = wbkCurBook.Sheets("August FMR")

For i = 2 To LastRow
    If ws.Cells(i, "B").Value = "CASE TOTAL" Then
        ws.Cells(i + 1, "F").Value = "OPEN LINE ITEMS"
        bot = i - 1
        
        ' Find the last "CSE" above row i
        Set cseCell = ws.Range("B1:B" & i - 1).Find(What:="CSE", SearchDirection:=xlPrevious)
        
        If Not cseCell Is Nothing Then
            top = cseCell.Row + 1
            Copyrange = "J" & top & ":" & "K" & bot
            n = Application.WorksheetFunction.CountIf(ws.Range(Copyrange), ">" & 0)
            ws.Cells(i + 1, "G").Value = n
        End If
    End If
Next i

This version uses SearchDirection:=xlPrevious to jump directly to the closest "CSE" row above the current "CASE TOTAL", eliminating the need for a nested loop entirely.

内容的提问来源于stack exchange，提问作者frank reynolds