如何合并data frame内交错重复行并按口味汇总冰淇淋勺数

假设你的数据框结构包含ID（个体标识）、flavor（冰淇淋口味）、scoops（勺数），以及无交错的标识列（如name、gender），可以用dplyr+tidyr高效处理，同时保留所有非交错列：

library(dplyr)
library(tidyr)

# 示例数据
df <- data.frame(
  ID = c(1,1,2,2),
  name = c("Alice","Alice","Bob","Bob"),
  gender = c("F","F","M","M"),
  flavor = c("Vanilla","Chocolate","Vanilla","Vanilla"),
  scoops = c(2,3,1,2)
)

# 自动按ID+所有非交错列分组，汇总口味勺数并转宽格式
result_df <- df %>%
  group_by_at(vars(-flavor, -scoops)) %>%  # 自动排除口味、勺数列，其余列全部分组
  summarize(total_scoops = sum(scoops), .groups = "drop") %>%
  pivot_wider(names_from = flavor, values_from = total_scoops, values_fill = 0)

• 逻辑：先确保同一ID的非交错标识列不会拆分，再按口味汇总勺数，最后转成“一行一个ID”的宽格式，缺失口味的勺数填0。

针对“Source overlaps destination areas”错误，核心是避免源数据与目标区域重叠，以下宏会将处理结果写入新工作表，同时完成ID+口味的勺数汇总：

Sub ConsolidateIceCreamData()
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim lastRow As Long, lastCol As Long
    Dim dict As Object, key As String
    Dim i As Long, j As Long
    Dim idCol As Integer, flavorCol As Integer, scoopsCol As Integer
    
    ' 配置源工作表（替换为你的数据所在表名）
    Set wsSource = ThisWorkbook.Worksheets("Sheet1")
    ' 创建新表存结果
    Set wsTarget = ThisWorkbook.Worksheets.Add
    wsTarget.Name = "ConsolidatedResult"
    
    ' 配置关键列位置（替换为你的实际列号，如ID在A列=1）
    idCol = 1
    flavorCol = 4
    scoopsCol = 5
    
    ' 获取源数据范围
    lastRow = wsSource.Cells(wsSource.Rows.Count, idCol).End(xlUp).Row
    lastCol = wsSource.Cells(1, wsSource.Columns.Count).End(xlToLeft).Column
    
    ' 复制表头到新表
    wsSource.Range(wsSource.Cells(1, 1), wsSource.Cells(1, lastCol)).Copy wsTarget.Cells(1, 1)
    wsTarget.Cells(1, lastCol + 1).Value = "总勺数"
    
    ' 初始化字典用于统计
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' 遍历源数据生成统计key
    For i = 2 To lastRow
        key = wsSource.Cells(i, idCol).Value & "|" & wsSource.Cells(i, flavorCol).Value
        ' 拼接所有非交错列（排除口味、勺数列）
        For j = 1 To lastCol
            If j <> flavorCol And j <> scoopsCol Then
                key = key & "|" & wsSource.Cells(i, j).Value
            End If
        Next j
        
        ' 累加勺数
        If Not dict.Exists(key) Then
            dict(key) = wsSource.Cells(i, scoopsCol).Value
        Else
            dict(key) = dict(key) + wsSource.Cells(i, scoopsCol).Value
        End If
    Next i
    
    ' 将统计结果写入新表
    Dim targetRow As Long: targetRow = 2
    For Each key In dict.Keys
        Dim keyParts As Variant: keyParts = Split(key, "|")
        ' 还原ID、非交错列、口味
        For j = 1 To lastCol
            If j = idCol Then
                wsTarget.Cells(targetRow, j).Value = keyParts(0)
            ElseIf j = flavorCol Then
                wsTarget.Cells(targetRow, j).Value = keyParts(1)
            ElseIf j <> scoopsCol Then
                wsTarget.Cells(targetRow, j).Value = keyParts(j - 1)
            End If
        Next j
        ' 写入总勺数
        wsTarget.Cells(targetRow, lastCol + 1).Value = dict(key)
        targetRow = targetRow + 1
    Next key
    
    ' 可选：一键转宽格式（替换为你的非交错列名）
    wsTarget.Range("A1").CurrentRegion.PivotTableWizard _
        TableDestination:=wsTarget.Cells(targetRow, 1), _
        RowFields:=Array("ID", "name", "gender"), _
        ColumnFields:="flavor", _
        DataFields:=Array("总勺数")
    
    MsgBox "汇总完成！"
End Sub

• 使用步骤：
  1. 按Alt+F11打开VBA编辑器，插入新模块粘贴代码；
  2. 修改代码中的工作表名、关键列号、非交错列名；
  3. 运行宏，结果自动生成在新工作表。

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