如何使用VBA将Excel中同姓名的锦标赛数据合并为单行记录

需求说明 #

原始锦标赛数据中，每个参赛姓名对应3条独立的比赛记录（每行一条），需要通过VBA处理，将同一个姓名的3场比赛结果合并到同一行，实现每个姓名仅占一行，包含全部三场比赛的结果数据。

VBA代码实现 #

Sub MergeTournamentResults()
    Dim wsSource As Worksheet, wsOutput As Worksheet
    Dim lastRow As Long, i As Long, outputRow As Long
    Dim nameDict As Object
    Dim currentName As String
    Dim resultCols As Variant
    
    ' 设置源工作表和输出工作表（可根据实际修改表名）
    Set wsSource = ThisWorkbook.Worksheets("原始数据")
    On Error Resume Next
    Set wsOutput = ThisWorkbook.Worksheets("合并结果")
    On Error GoTo 0
    If wsOutput Is Nothing Then
        Set wsOutput = ThisWorkbook.Worksheets.Add(After:=wsSource)
        wsOutput.Name = "合并结果"
    End If
    
    ' 初始化字典用于存储姓名对应的比赛结果
    Set nameDict = CreateObject("Scripting.Dictionary")
    resultCols = Array("比赛1结果", "比赛2结果", "比赛3结果") ' 对应输出列的表头，可根据实际调整
    
    ' 写入输出表头（假设原始表头是A列姓名，B列比赛结果）
    wsOutput.Cells(1, 1).Value = "姓名"
    For i = 0 To UBound(resultCols)
        wsOutput.Cells(1, i + 2).Value = resultCols(i)
    Next i
    outputRow = 2
    
    ' 遍历原始数据
    lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    For i = 2 To lastRow
        currentName = wsSource.Cells(i, "A").Value
        If nameDict.Exists(currentName) Then
            ' 已存在的姓名，追加比赛结果到对应位置
            nameDict(currentName) = nameDict(currentName) & "|" & wsSource.Cells(i, "B").Value
        Else
            ' 新姓名，记录首次比赛结果
            nameDict(currentName) = wsSource.Cells(i, "B").Value
        End If
    Next i
    
    ' 将字典中的数据写入输出工作表
    For Each currentName In nameDict.Keys
        wsOutput.Cells(outputRow, 1).Value = currentName
        ' 拆分结果到对应列
        Dim resultArr As Variant
        resultArr = Split(nameDict(currentName), "|")
        For i = 0 To UBound(resultArr)
            wsOutput.Cells(outputRow, i + 2).Value = resultArr(i)
        Next i
        outputRow = outputRow + 1
    Next currentName
    
    ' 自动调整列宽
    wsOutput.UsedRange.Columns.AutoFit
    MsgBox "数据合并完成！", vbInformation
End Sub

代码说明 #

• 使用Scripting.Dictionary快速去重并收集每个姓名的所有比赛结果，避免重复遍历数据
• 原始数据默认姓名在A列、比赛结果在B列；输出表中姓名在A列，后续列依次存放3场比赛结果，可根据实际列位置修改代码中的列标识
• 自动创建输出工作表（如果不存在），并写入对应表头
• 最后自动调整输出表的列宽，提升可读性

使用方法 #

1. 将原始数据放在名为「原始数据」的工作表中（或修改代码中wsSource的表名）
2. 按Alt+F11打开VBA编辑器，插入新模块，粘贴上述代码
3. 运行MergeTournamentResults宏即可完成数据合并

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