Question

VBA新手。尝试运行与每个ID相关的唯一ID和小计值列表。

之后，总和需要显示在第一行的不同列中。

考虑：

当它找到一个新的id时，小计需要重新开始并且仅对与其相关的值块进行小计。
每个小计只需在列表中唯一ID的第一个实例旁边显示一次。
每个新工作表将有5 k或更多行，数据将在同一列中。大量数据。
我的工作表中的列实际上并不是彼此相邻，而是在同一张表中。
在每个印刷品中，custid将在另一行发生变化。它需要遍历id并查找更改并仅对该custid的值求和。之后，总和需要显示在第一行的不同列中。

这是一些基本的样本数据：

Totl Subttl CustID Amt。

        123456  55.74
        123456  61.47
        223456  44.53
        223456  142.11
        223456  -142.11
        333456  44.53
        333456  52.89
        333456  118.37
        333456  354.80
        443456  6.49
        443456  44.53
        443456  162.74

To This：

Totl Subttl CustID Amt。

946.09      117.21  123456  55.74
                    123456  61.47
            44.53   223456  44.53
                    223456  142.11
                    223456  -142.11
            570.59  333456  44.53
                    333456  52.89
                    333456  118.37
                    333456  354.80
            213.76  443456  6.49
                    443456  44.53
                    443456  162.74

Answer 1

事实证明这比我最初预期的要简单。此代码假定已对唯一ID号列进行排序，使得它们始终组合在一起，而不是随机分布在整个工作表中。（如果不是这种情况请说，我将首先包括一个排序选项）

修改我更新了代码，首先包含一个排序。它还将它复制到第二张表（Sheet2）上，以便在出现问题时不会丢失原始数据列表。

编辑2 刚想了想，如果你在大型数据集上这样做，那么你会希望关闭屏幕更新以加快速度

Sub sumAndFormat() Dim lastRow As Long Dim activeRow As Long Dim uniqueID As Long Dim totalSum As Currency Dim subRow As Long Dim subTotal As Currency Application.ScreenUpdating = False ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A1"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("Sheet1").Sort .SetRange Range("A1:B12") .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With lastRow = Sheets("sheet1").Cells(Sheets("sheet1").Rows.Count, "A").End(xlUp).row totalSum = 0 subTotal = 0 subRow = 1 uniqueID = Sheets("Sheet1").Cells(1, 1).value For i = 1 To lastRow totalSum = totalSum + Sheets("Sheet1").Cells(i, 2).value If uniqueID = Sheets("Sheet1").Cells(i, 1) Then subTotal = subTotal + Sheets("Sheet1").Cells(i, 2).value Sheets("Sheet2").Cells(subRow, 2).value = subTotal MsgBox (subTotal) Else uniqueID = Sheets("Sheet1").Cells(i, 1).value subTotal = Sheets("Sheet1").Cells(i, 2).value subRow = i End If Sheets("Sheet2").Cells(i, 3).value = Sheets("Sheet1").Cells(i, 1).value Sheets("Sheet2").Cells(i, 4).value = Sheets("Sheet1").Cells(i, 2).value Next i Sheets("Sheet2").Cells(1, 1).value = totalSum Application.ScreenUpdating = True End Sub

VBA，需要基于另一列的更改的条件求和

1 个答案: