如何在Excel中合并两列并按存在情况设置删除线与颜色格式？

R方案（基于openxlsx包，保留格式导出） #

1. 安装并加载工具包 #

install.packages("openxlsx")
library(openxlsx)

2. 导入或构造数据 #

替换下方示例数据为你实际的Before和After列数据：

df <- data.frame(
  Before = c("A", "B", "C", "D"),
  After = c("B", "C", "E", "F")
)

3. 处理数据，生成唯一字母列表及格式标记 #

# 提取两列所有唯一字母
all_letters <- unique(c(df$Before, df$After))

# 标记每个字母的归属类型：仅Before、仅After、两者都有
letter_type <- sapply(all_letters, function(x) {
  in_before <- x %in% df$Before
  in_after <- x %in% df$After
  if (in_before & !in_after) "only_before"
  else if (!in_before & in_after) "only_after"
  else "both"
})

4. 创建Excel文件并应用格式 #

# 初始化工作簿和工作表
wb <- createWorkbook()
addWorksheet(wb, "合并结果")

# 定义格式：删除线、自定义颜色（这里用红色）
style_strike <- createStyle(textDecoration = "lineThrough")
style_color <- createStyle(fontColour = "#FF0000")

# 写入数据到Excel
writeData(wb, "合并结果", x = all_letters, startCol = 1, startRow = 1)

# 遍历每个字母，应用对应格式
for (i in seq_along(all_letters)) {
  type <- letter_type[i]
  if (type == "only_before") {
    addStyle(wb, "合并结果", style_strike, rows = i, cols = 1)
  } else if (type == "only_after") {
    addStyle(wb, "合并结果", style_color, rows = i, cols = 1)
  }
}

# 保存文件
saveWorkbook(wb, "合并字母结果.xlsx", overwrite = TRUE)

VBA方案（直接在Excel中操作） #

适用于不想用R，直接在Excel内完成的场景：

1. 准备数据 #

确保你的Before列在Sheet1的A列，After列在B列，表头位于第1行。

2. 插入并运行VBA代码 #

• 按Alt + F11打开VBA编辑器
• 右键点击当前工作簿 → 插入 → 模块
• 粘贴以下代码：

Sub MergeAndFormatLetters()
    Dim wsSource As Worksheet, wsResult As Worksheet
    Dim beforeRange As Range, afterRange As Range
    Dim letter As Variant, allLetters As Collection
    Dim rowNum As Integer
    
    ' 指定数据所在工作表，可根据实际修改
    Set wsSource = ThisWorkbook.Sheets("Sheet1")
    
    ' 检查是否已存在结果表，不存在则新建
    On Error Resume Next
    Set wsResult = ThisWorkbook.Sheets("合并结果")
    On Error GoTo 0
    If wsResult Is Nothing Then
        Set wsResult = ThisWorkbook.Sheets.Add(After:=wsSource)
        wsResult.Name = "合并结果"
    End If
    
    ' 提取两列非空数据范围
    Set beforeRange = wsSource.Range("A2:A" & wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row)
    Set afterRange = wsSource.Range("B2:B" & wsSource.Cells(wsSource.Rows.Count, "B").End(xlUp).Row)
    
    ' 收集所有唯一字母
    Set allLetters = New Collection
    For Each letter In beforeRange
        If Not IsEmpty(letter) Then
            On Error Resume Next
            allLetters.Add letter.Value, Key:=CStr(letter.Value)
            On Error GoTo 0
        End If
    Next
    For Each letter In afterRange
        If Not IsEmpty(letter) Then
            On Error Resume Next
            allLetters.Add letter.Value, Key:=CStr(letter.Value)
            On Error GoTo 0
        End If
    Next
    
    ' 写入结果并设置格式
    rowNum = 1
    wsResult.Cells(rowNum, 1).Value = "合并字母"
    rowNum = rowNum + 1
    
    For Each letter In allLetters
        wsResult.Cells(rowNum, 1).Value = letter
        Dim inBefore As Boolean, inAfter As Boolean
        inBefore = Not IsError(Application.Match(letter, beforeRange, 0))
        inAfter = Not IsError(Application.Match(letter, afterRange, 0))
        
        ' 仅Before的字母加删除线，仅After的字母设为红色
        If inBefore And Not inAfter Then
            wsResult.Cells(rowNum, 1).Font.Strikethrough = True
        ElseIf Not inBefore And inAfter Then
            wsResult.Cells(rowNum, 1).Font.Color = RGB(255, 0, 0)
        End If
        rowNum = rowNum + 1
    Next
End Sub

• 返回Excel界面，按Alt + F8，选择MergeAndFormatLetters点击执行，结果会生成在新的「合并结果」工作表中。

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