VBA，需要基于另一列中的更改的有条件总和

debugcn 发表于 Dev

CapTFalcon

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

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

注意事项：

当它找到新的ID时，小计需要重新开始，并且仅小计与之相关的值的块。
每个小计仅需在列表中唯一ID的第一个实例旁边显示一次。
每个新工作表将具有5 k行或更多，并且数据将在相同的列中。大量数据。
我的工作表中的各列实际上并不是彼此相邻，而是在同一工作表中。
在每份印刷品中，储量将在不同的行上变化。它需要遍历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

为此：

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

梅森博士

事实证明，这比我最初预期的要简单。此代码假定唯一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

本文收集自互联网，转载请注明来源。

如有侵权，请联系[email protected] 删除。