Question

我有这个表约50,000行，我希望Excel能够通过并分配一个数字或字母。

基本上我试图根据数据总和大于1,000,000来对数据行进行分组。

如果该行中的单元格A小于1,000,000，它将转到下一行并将前一个单元格A添加到当前单元格，依此类推。这一直持续到所有行的总和> = 1,000,000。当发生这种情况时，会“分配”一个数字（如在行的末尾输入的那样）。

示例数据：

Table example

这是我目前的“伪”代码：

For x = 2 to lastrow
    y = 1

    If Range("A" & x).value < 1000000 Then

'I know something needs to be entered here but I don't know what

        Do while balance < 1000000

            sumbalance = Range("A" & x) + Range("A" & x + 1)

'Until sumbalance >= 1000000 Then Range("A" & x).Offset(0, 2).value = y

     Else

         Range("A" & x).offset(0, 2).value = y + 1 '(?)         

Next x

有人能指出我正确的方向吗？

Answer 1

对于50K行，您可能会喜欢将值移动到变量数组中进行处理，然后将它们返回到工作表 en masse 。

Dim i As Long, rws As Long, dTTL As Double, v As Long, vVALs As Variant

With Worksheets("Sheet2")
    vVALs = .Range(.Cells(2, "A"), .Cells(.Cells(Rows.Count, "A").End(xlUp).Row, "B")).Value2
    For v = LBound(vVALs, 1) To UBound(vVALs, 1)
        dTTL = dTTL + vVALs(v, 1): rws = rws + 1
        If dTTL >= 10 ^ 6 Then
            For i = v - rws + 1 To v
                vVALs(i, 2) = rws
            Next i
            dTTL = 0: rws = 0
        End If
    Next v
    .Cells(2, "A").Resize(UBound(vVALs, 1), UBound(vVALs, 2)) = vVALs
End With

如果最后一组数字未达到1M标记，则不清楚如何结束序列。

Answer 2

我希望我的评论很清楚，如果代码符合您的要求，请告诉我。

  Option Explicit

Sub balance()

Dim wb As Workbook
Dim ws As Worksheet
Dim x As Double, y As Integer
Dim lastrow As Long
Dim sumbalance As Double
Dim Reached As Boolean

  Set wb = ThisWorkbook
  Set ws = wb.Sheets("Sheet1") 'Change the name of the sheet to yours

  lastrow = ws.Range("A" & Rows.Count).End(xlUp).Row 'Check the last Row

For x = 2 To lastrow

            y = 1 ' Number 1 will be past in column C when sumblance >= 1'000'000
Reached = False
Do

If Range("A" & x).Value < 10 ^ 6 Then ' Value less than 1'000'000

                    If sumbalance = 0 Then 'Start the sum balance at 0
                            sumbalance = Range("A" & x)

                    Else
                            sumbalance = Range("A" & x) + sumbalance 'We add the previous amount to the new one
                             x = x + 1
                    End If

     Else

     Range("A" & x).Offset(0, 2).Value = y ' If the number is directly >= 1'000'000
     Reached = True
 End If



    Loop Until sumbalance >= 10 ^ 6 Or x = lastrow Or Reached = True

        Range("A" & x).Offset(0, 2).Value = y 'when the Sum Balance is >= 1'000'000 so 1 is paste in column c
        sumbalance = 0 'Reinitialize the balance to 0

        Next x

End Sub

Excel VBA循环表和总结值

2 个答案: