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

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

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

考虑事项：

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

这是一些基本的示例数据：

总客户金额

        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

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

为此：

总客户金额

        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

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

---

事实上，这是非常接近完美的我的申请谢谢你。这就是我最后使用的。简单有效。谢谢你的屏幕更新小贴士。非常有用。除此之外，我还有大约两页的VBA代码，所有这些代码都作用于那5公里的线路上，所以更新变成了一个巨大的帮助！