Excel姓名表格自动对齐宏故障：Yuna/Angel数据丢失修复需求

需求：处理姓名表格，当底部行出现新姓名时，自动将列右移，同时将相同姓名对齐至同一列。

• 原始表：表格各行列数不一致，底部行存在新增姓名
• 当前问题：执行AlignNamesTwoPass宏后，虽实现了列右移与姓名对齐，但部分姓名（如F6、F7的Yuna，G4、G5的Angel）丢失，且结果中出现不必要的"Null"文本
• 预期结果：所有姓名完整保留，相同姓名对齐至同一列，空单元格保持空白，新增姓名列自动右移

问题原因 #

1. 列数计算错误：原代码仅以第一行的最后一列作为表格最大列数，导致底部行的新增列（如F、G列）未被遍历，对应姓名未被处理，最终丢失。
2. 空值处理不当：原代码将空单元格替换为"Null"并分配固定列，不仅不符合预期的空白显示，还可能干扰正常姓名的列分配逻辑。

修复后的VBA代码 #

Sub AlignNamesTwoPass()
    Dim wsRaw As Worksheet, wsResult As Worksheet
    Dim lastRowRaw As Long, lastColRaw As Long
    Dim dict As Object
    Dim rRaw As Long, cRaw As Long
    Dim name As String

    ' 定义工作表名称
    Const RAW_SHEET_NAME As String = "Sheet1"
    Const RESULT_SHEET_NAME As String = "Result_Table"

    ' 绑定工作表
    On Error Resume Next
    Set wsRaw = ThisWorkbook.Sheets(RAW_SHEET_NAME)
    Set wsResult = ThisWorkbook.Sheets(RESULT_SHEET_NAME)
    On Error GoTo 0

    If wsRaw Is Nothing Or wsResult Is Nothing Then
        MsgBox "错误：未找到指定工作表！", vbCritical
        Exit Sub
    End If

    ' 获取原始数据的最后一行
    lastRowRaw = wsRaw.Cells(wsRaw.Rows.Count, 1).End(xlUp).Row

    ' 修正：遍历所有行，计算表格实际使用的最大列数（避免遗漏底部行的新增列）
    lastColRaw = 0
    For rRaw = 1 To lastRowRaw
        Dim currentCol As Long
        currentCol = wsRaw.Cells(rRaw, wsRaw.Columns.Count).End(xlToLeft).Column
        If currentCol > lastColRaw Then
            lastColRaw = currentCol
        End If
    Next rRaw

    ' 清空结果表旧数据
    wsResult.Cells.ClearContents

    ' 初始化字典，用于记录姓名对应的列号
    Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare ' 不区分大小写（可选，根据需求调整）

    ' 第一遍遍历：从下往上收集所有唯一姓名，分配列号（新姓名优先分配右侧列）
    For rRaw = lastRowRaw To 1 Step -1
        For cRaw = 1 To lastColRaw
            name = Trim(wsRaw.Cells(rRaw, cRaw).Value)
            ' 跳过空单元格，不参与列分配
            If name <> "" Then
                If Not dict.Exists(name) Then
                    dict.Add name, dict.Count + 1 ' 新姓名分配下一个可用列
                End If
            End If
        Next cRaw
    Next rRaw

    ' 第二遍遍历：将姓名写入结果表对应的列
    For rRaw = 1 To lastRowRaw
        For cRaw = 1 To lastColRaw
            name = Trim(wsRaw.Cells(rRaw, cRaw).Value)
            If name <> "" Then
                ' 根据字典找到对应列，写入姓名
                wsResult.Cells(rRaw, dict(name)).Value = name
            End If
            ' 空单元格不做处理，保持空白
        Next cRaw
    Next rRaw

Cleanup:
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    MsgBox "姓名对齐完成！结果已写入 'Result_Table' 工作表。", vbInformation
End Sub

修复说明 #

1. 修正列数计算逻辑：通过遍历所有行，获取表格实际使用的最大列数，确保底部行的新增列不会被遗漏，解决了姓名丢失的问题。
2. 优化空值处理：取消空单元格替换为"Null"的逻辑，直接跳过空单元格的列分配与写入，结果表中空单元格保持空白，符合预期格式。
3. 新增大小写不敏感设置（可选）：添加dict.CompareMode = vbTextCompare，确保同名但大小写不同的姓名会被对齐到同一列（可根据需求注释该行）。

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