Блог

Новичок в VBA. Попытка просмотреть список уникальных идентификаторов и промежуточных итоговых значений, связанных с каждым идентификатором.

После этого эта общая сумма должна быть отображена в другом столбце в первой строке.

Соображения:

• Поскольку он находит новый идентификатор, промежуточный итог должен начинаться заново и только промежуточный итог блока значений, связанных с ним.
• Каждый промежуточный итог должен отображаться только один раз рядом с первым экземпляром уникального идентификатора в списке.
• каждый новый лист будет содержать не менее 5 тыс. строк, и данные будут содержаться в одних и тех же столбцах. Много данных.
• Столбцы в моем листе на самом деле физически не расположены рядом друг с другом, а находятся на одном листе.
• при каждой печати идентификатор custid будет меняться в другой строке. Ему нужно перебрать идентификаторы, найти изменение и суммировать значения только для этого 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
 

Это оказалось проще, чем я ожидал. Этот код предполагает, что столбец уникальных идентификационных номеров упорядочен таким образом, чтобы они всегда группировались вместе, а не распределялись случайным образом по всему листу. (Если это не так, пожалуйста, скажите, и я сначала включу опцию сортировки)

РЕДАКТИРОВАТЬ Я обновил код, чтобы сначала включить сортировку. Он также копирует ее на второй лист (Лист2), чтобы вы не потеряли исходный список данных в случае, если что-то пойдет не так.

РЕДАКТИРОВАТЬ 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