Код VBA для поиска суммы определенного столбца на основе определенного столбца в Excel

Question

CHEQUE_NUMBER                TC_Group    NET_AMOUNT

A00147892                     Food         2650
A00147892                     Tax          250.43
A00147892                     Tax          250.43
A00147892                     Tips         132.5
A00147892                     pay          3283.36

Я хочу рассчитать Net_Amount на основе TC_Group='food', используя cheque_number в качестве базовых критериев, используя код VB

, т. Е. Вывод будет иметь вид:

CHEQUE_NUMBER                TC_Group    NET_AMOUNT
A00147892                     Food         2650

Answer 1

Предположим, что данные отображаются на листе 1, как показано на рисунке ниже:

Вы можете попробовать:

Option Explicit

Sub Test()

    Dim Lastrow As Long, i As Long, y As Long, LastrowList As Long, Lines As Long
    Dim ChequeNo As String, Category As String
    Dim Sum As Double

    Category = "Food"

    With ThisWorkbook.Worksheets("Sheet1")
        'Find of Sheet1 & Column A lastrow
        Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row

        For i = 2 To Lastrow
            If .Range("A" & i).Interior.Color <> 65535 Then
                ChequeNo = .Range("A" & i).Value
                Sum = .Range("C" & i).Value

                    For y = i + 1 To Lastrow

                        If .Range("A" & y).Interior.Color <> 65535 And .Range("A" & y).Value = ChequeNo And .Range("B" & y).Value = Category Then
                            Sum = Sum + .Range("C" & i).Value
                            With .Range("A" & y & ":C" & y).Interior
                                .Color = 65535
                            End With
                        End If

                    Next y

                    With .Range("A" & i & ":C" & i).Interior
                        .Color = 65535
                    End With

                    LastrowList = .Cells(.Rows.Count, "A").End(xlUp).Row

                    If Lastrow = LastrowList Then
                        Lines = 2
                    Else
                        Lines = 1
                    End If

                    .Cells(LastrowList + Lines, 1).Value = ChequeNo
                    .Cells(LastrowList + Lines, 2).Value = Category
                    .Cells(LastrowList + Lines, 3).Value = Sum

                End If

        Next i

    End With

End Sub   

Примечание: Проверенное значение будет выделено желтым цветом.