Excel合并重复CompanyID行并动态生成列，求VBA/R方案及pivot_wider替代法

R语言实现方案 #

1. 解决tidyr包依赖报错 #

若反复更新rlang仍报错，建议彻底清理并重装相关包：

# 卸载冲突包
remove.packages(c("rlang", "tidyr", "dplyr"))
# 重启R会话后重装
install.packages("tidyr", dependencies = TRUE)

若问题仍存在，可使用基础R的reshape函数替代pivot_wider，无需依赖tidyr。

2. 用tidyr::pivot_wider实现需求 #

假设数据框名为df，包含companyid、rangestart、rangeend三列：

library(dplyr)
library(tidyr)

# 给每个companyid的重复项编号
df <- df %>%
  group_by(companyid) %>%
  mutate(row_num = row_number()) %>%
  ungroup()

# 动态生成符合命名规则的宽表
wide_df <- df %>%
  pivot_wider(
    id_cols = companyid,
    names_from = row_num,
    values_from = c(rangestart, rangeend),
    names_glue = "{.value}.{row_num}"
  )

names_glue参数会自动生成rangestart.1、rangeend.1、rangestart.2这类符合要求的列名。

3. 基础R替代方案（无需tidyr） #

# 给每个companyid的重复项编号
df$row_num <- with(df, ave(rep(1, nrow(df)), companyid, FUN = seq_along))

# 转换为宽表，自动生成目标列名
wide_df <- reshape(
  df,
  idvar = "companyid",
  timevar = "row_num",
  direction = "wide",
  sep = "."
)

该方法无需额外包，生成的列名格式与pivot_wider完全一致。

VBA宏实现方案 #

以下宏可合并重复companyid，动态生成符合命名规则的新列，且不会覆盖现有数据：

Sub MergeDuplicateCompanyID()
    Dim ws As Worksheet
    Dim lastRow As Long, lastCol As Long
    Dim i As Long, j As Long, k As Long
    Dim companyID As String
    Dim dict As Object
    
    Set ws = ActiveSheet
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row '假设companyid在A列
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' 收集每个companyid对应的所有rangestart和rangeend
    For i = 2 To lastRow
        companyID = ws.Cells(i, "A").Value
        If Not dict.exists(companyID) Then
            dict.Add companyID, New Collection
        End If
        ' 假设rangestart在B列，rangeend在C列，可按需修改列号
        dict(companyID).Add Array(ws.Cells(i, "B").Value, ws.Cells(i, "C").Value)
    Next i
    
    ' 清空原有数据（保留表头）
    ws.Rows("2:" & lastRow).ClearContents
    
    ' 写入合并后的数据
    i = 2
    For Each key In dict.keys
        ws.Cells(i, "A").Value = key
        k = 0
        ' 动态生成新列并写入对应值
        For j = 1 To dict(key).Count
            k = k + 1
            ' 创建新列名（若不存在）
            If ws.Cells(1, lastCol + 2 * k - 1).Value <> "rangestart." & k Then
                ws.Cells(1, lastCol + 2 * k - 1).Value = "rangestart." & k
            End If
            If ws.Cells(1, lastCol + 2 * k).Value <> "rangeend." & k Then
                ws.Cells(1, lastCol + 2 * k).Value = "rangeend." & k
            End If
            ' 写入数据
            ws.Cells(i, lastCol + 2 * k - 1).Value = dict(key)(j)(0)
            ws.Cells(i, lastCol + 2 * k).Value = dict(key)(j)(1)
        Next j
        i = i + 1
    Next key
    
    MsgBox "合并完成！"
End Sub

宏使用说明： #

• 若companyid、rangestart、rangeend不在A、B、C列，修改代码中对应的列号即可。
• 新列会自动添加在现有列的右侧，不会覆盖原有数据。
• 运行前建议备份原始数据。

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