Got it, let's build a reliable VBA macro that handles your exact requirement. Here's a step-by-step solution tailored to your Excel worksheet setup:

First, let's outline what this macro will accomplish:

• Identify duplicate rows using columns A to I as the matching criteria
• Sum up the values in column J for all duplicate entries
• Keep only one instance of each duplicate row, updating its J column with the total sum
• Delete all other duplicate rows

Complete Macro Code #

Paste this into your Excel VBA editor:

Sub SumDuplicatesAndCleanUp()
    Dim targetSheet As Worksheet
    Dim lastDataRow As Long
    Dim currentRow As Long, compareRow As Long
    Dim hasDuplicates As Boolean
    Dim totalSum As Double
    
    ' Replace "DataSheet" with your actual worksheet name
    Set targetSheet = ThisWorkbook.Worksheets("DataSheet")
    
    ' Speed up macro by disabling screen updates and events
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    ' Find the last row with data in column A
    lastDataRow = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row
    
    ' Loop from bottom to top to avoid skipping rows when deleting
    For currentRow = lastDataRow To 2 Step -1
        totalSum = targetSheet.Cells(currentRow, "J").Value
        hasDuplicates = False
        
        ' Compare current row with all rows above it
        For compareRow = currentRow - 1 To 2 Step -1
            ' Check if columns A-I are identical
            If targetSheet.Range("A" & currentRow & ":I" & currentRow).Value = _
               targetSheet.Range("A" & compareRow & ":I" & compareRow).Value Then
                hasDuplicates = True
                ' Add the J column value to the total sum
                totalSum = totalSum + targetSheet.Cells(compareRow, "J").Value
                ' Delete the duplicate row
                targetSheet.Rows(compareRow).Delete
            End If
        Next compareRow
        
        ' Update J column with total sum if duplicates were found
        If hasDuplicates Then
            targetSheet.Cells(currentRow, "J").Value = totalSum
        End If
    Next currentRow
    
    ' Re-enable screen updates and events
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    MsgBox "Duplicate rows processed successfully!", vbInformation
End Sub

Important Notes & Customizations #

• Worksheet Name: Don't forget to replace "DataSheet" with your actual worksheet name in the code.
• Header Row: This macro assumes you have a header row (row 1). If you don't have a header, change the loop start value from 2 to 1 in both For loops.
• Performance: Looping from bottom to top prevents row-skipping issues when deleting entries. Disabling screen updates makes the macro run way faster, especially with large datasets.
• Data Type: totalSum uses Double to handle both whole numbers and decimals in column J. If you only work with integers, you can switch it to Long.

How to Use This Macro #

1. Open your Excel file.
2. Press Alt + F11 to launch the VBA Editor.
3. Right-click your workbook in the Project Explorer > Insert > Module.
4. Paste the code into the new module.
5. Adjust the worksheet name if needed.
6. Press F5 to run the macro, or assign it to a button for quick access later.

内容的提问来源于stack exchange，提问作者Avinash