时间戳

首页 > 解决方案 > 根据其他单元格值合并和汇总重复值

excel - 根据其他单元格值合并和汇总重复值

问题描述

我正在尝试合并重复值并根据另一个单元格值列 A 和 B 对列 C 中的值求和。我已经尝试过，但它正在合并列 A 中提到的所有值。

数据

结果
预期结果

Dim c1 As Range, sht1 As Worksheet, currV1
Dim n1 As Long, rw1 As Range, r1 As Range

Set sht1 = ActiveSheet
Set c1 = sht.Range("A2") 
currV1 = Chr(1)   

Do
    If c1.Value <> currV1 Then
        If n1 > 1 Then
            Set rw1 = c1.EntireRow.Range("A1,B1") 
            Application.DisplayAlerts = False
            For Each r1 In rw1.Cells
                r1.Offset(-n1).Resize(n1).merge
            Next r1
            Application.DisplayAlerts = True
        End If
        currV1 = c1.Value
        n1 = 1
    Else
        n1 = n1 + 1 'increment count for this value
    End If

    If Len(c1.Value) = 0 Then Exit Do 'exit on first empty cell
    Set c1 = c1.Offset(1, 0) 'next row down
Loop

For r3 = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    MergeRows = Range("A" & r3).MergeArea.Rows.Count
    If MergeRows > 1 Then
        t = "=SUM(C" & r3 & ":C" & r3 + MergeRows - 1 & ")"
        t = Evaluate(t)
        With Range("C" & r3 & ":C" & r3 + MergeRows - 1)
            .MergeCells = True
            .Value = t
        End With
        r3 = r3 + MergeRows - 1
    End If
Next r3

标签： excelvbamergesum

解决方案

我重做了你那里的大部分内容，现在有点短了。

还要Option Explicit在模块顶部放置未声明的变量。

Sub test()
    Dim i As Long
    Dim lr As Long
    
    Dim val As String
    Dim total As Long
    Application.DisplayAlerts = False
    With ActiveSheet
        lr = .Cells(.Rows.Count, 1).End(xlUp).Row
        val = .Cells(2, 1).Value & .Cells(2, 2).Value
        For i = 2 To lr
            total = .Cells(i, 3).Value
            If .Cells(i, 1).Value & .Cells(i, 2).Value <> val Then
                If .Cells(i, 1).Value = .Cells(i, 1).Offset(-1).MergeArea(1, 1).Value Then
                    total = .Cells(i, 3).Offset(-1).MergeArea(1, 1) + .Cells(i, 3).Value
                    .Range(.Cells(i, 3), .Cells(i, 3).Offset(-1)).Merge
                    .Cells(i, 3).MergeArea(1, 1).Value = total
                    val = .Cells(i, 1).Value & .Cells(i, 2).Value
                Else
                    val = .Cells(i, 1).Value & .Cells(i, 2).Value
                End If
            Else
                If Not i = 2 Then
                    .Range(.Cells(i, 1), .Cells(i, 1).Offset(-1)).Merge
                    .Range(.Cells(i, 2), .Cells(i, 2).Offset(-1)).Merge
                    .Range(.Cells(i, 3), .Cells(i, 3).Offset(-1)).Merge
                End If
            End If
        Next i
    End With
    Application.DisplayAlerts = True
End Sub

推荐阅读