Excel VBA通​​过表循环并总结值

我有这张约5万行的表格，我希望Excel能够通过并分配一个数字或字母。

基本上我试图根据他们的总和大于1,000,000来分组数据。

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

样本数据：

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

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行，您可能会喜欢将值移动到变体数组中进行处理，然后将其全部返回到工作表。

 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