代码只能工作到第100行

Question

下面的代码只能工作到第100行。后续不行不通。你能告诉我为什么吗？

    Sub sum1()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim x As Double, y As Integer
    Dim lastrow As Long
    Dim sumbalance As Integer
    Dim Reached As Boolean
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Sheet1")
    sumbalance = 0

    lastrow = ws.Range("A" & Rows.Count).End(xlUp).Row

   For x = 2 To lastrow

    If Range("A" & x).Value = Range("A" & x + 1) Then

            sumbalance = sumbalance + Range("B" & x).Value

      End If
    Else
         sumbalance = sumbalance + Range("B" & x).Value
         Range("C" & x).Value = sumbalance
         sumbalance = 0
    End If

    Next x
    [Not summing after 100th row][1]End Sub

在图像中，您可以看到它在第100行之后没有求和

Answer 1

你可以使用公式

例如，您的列A数字似乎是＆＃34;相邻＆＃34; （即，所有相同的数字出现彼此相邻）并且没有可能的重复（即，一旦某些数字出现结束，它不再出现在后续行中）。因此你可以使用它：

Sub sum1()
    With ThisWorkbook.Sheets("Sheet1")
        .Range("A2", .Cells(.Rows.count, 1).End(xlUp)).Offset(, 2).FormulaR1C1 = "=IF(RC1<>R[1]C1,SUMIF(C1,RC1,C2),"""")"
    End With
End Sub

并且您是否希望摆脱公式并仅保留其结果值：

Sub sum1()    
    With ThisWorkbook.Sheets("Sheet1")
        With .Range("A2", .Cells(.Rows.count, 1).End(xlUp)).Offset(, 2)
            .FormulaR1C1 = "=IF(RC1<>R[1]C1,SUMIF(C1,RC1,C2),"""")"
            .Value = .Value
            If WorksheetFunction.CountBlank(.Cells) > 0 Then .SpecialCells(xlCellTypeBlanks).ClearContents
        End With
    End With
End Sub