如何用VBA生成可对齐特定字符的字符串（Times-Roman 8号字体）

针对Times-Roman 8号字体，要批量实现字符串中“x”和“=”的对齐，同时整体右对齐，可通过以下方案解决——核心是利用字体的实际宽度计算，搭配**非断空格（Chr(160)）**填充（避免普通空格宽度不一致的问题），具体实现如下：

• 拆分所有目标字符串为「操作数1」「操作数2」「结果」三个部分；
• 遍历所有字符串，用TextWidth方法计算各部分的实际显示宽度，记录每个部分的最大宽度；
• 对每个字符串，按最大宽度填充非断空格，调整操作数1、操作数2的宽度，使“x”和“=”位置统一；
• 最后统一调整整体字符串的长度，实现右对齐。

Sub AlignStringsWithXAndEqual()
    Dim ws As Worksheet
    Dim rng As Range, cell As Range
    Dim allOp1 As Collection, allOp2 As Collection, allRes As Collection
    Dim maxOp1Width As Double, maxOp2Width As Double, maxTotalWidth As Double
    Dim op1 As String, op2 As String, res As String
    Dim paddedOp1 As String, paddedOp2 As String, finalStr As String
    Dim padCount As Integer
    
    ' 设置工作表和目标范围（假设原始数据在A列，从A2开始）
    Set ws = ThisWorkbook.ActiveSheet
    Set rng = ws.Range("A2:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
    
    ' 初始化集合存储各部分内容
    Set allOp1 = New Collection
    Set allOp2 = New Collection
    Set allRes = New Collection
    
    ' 设置结果列字体为Times-Roman 8号
    ws.Range("B2:B" & rng.Rows.Count + 1).Font.Name = "Times New Roman"
    ws.Range("B2:B" & rng.Rows.Count + 1).Font.Size = 8
    
    ' 第一步：拆分字符串并计算各部分最大显示宽度
    For Each cell In rng
        If cell.Value <> "" Then
            ' 按固定分隔符拆分字符串
            op1 = Split(cell.Value, " x ")(0)
            op2 = Split(Split(cell.Value, " x ")(1), " = ")(0)
            res = Split(cell.Value, " = ")(1)
            
            allOp1.Add op1
            allOp2.Add op2
            allRes.Add res
            
            ' 利用临时单元格计算宽度，更新最大值
            With ws.Range("B1")
                .Font.Name = "Times New Roman"
                .Font.Size = 8
                .Value = op1
                If .TextWidth > maxOp1Width Then maxOp1Width = .TextWidth
                .Value = op2
                If .TextWidth > maxOp2Width Then maxOp2Width = .TextWidth
                .Value = op1 & " x " & op2 & " = " & res
                If .TextWidth > maxTotalWidth Then maxTotalWidth = .TextWidth
            End With
        End If
    Next cell
    
    ' 第二步：生成对齐后的字符串并写入结果列
    For i = 1 To allOp1.Count
        op1 = allOp1(i)
        op2 = allOp2(i)
        res = allRes(i)
        
        ' 填充操作数1：右对齐到最大宽度，左侧补非断空格
        With ws.Range("B1")
            .Value = op1
            padCount = (maxOp1Width - .TextWidth) / .TextWidth(Chr(160))
            paddedOp1 = String(Round(padCount), Chr(160)) & op1
        End With
        
        ' 填充操作数2：左对齐到最大宽度，右侧补非断空格
        With ws.Range("B1")
            .Value = op2
            padCount = (maxOp2Width - .TextWidth) / .TextWidth(Chr(160))
            paddedOp2 = op2 & String(Round(padCount), Chr(160))
        End With
        
        ' 组合中间对齐部分
        middleStr = paddedOp1 & " x " & paddedOp2 & " = " & res
        
        ' 整体右对齐：左侧补非断空格到最大总宽度
        With ws.Range("B1")
            .Value = middleStr
            padCount = (maxTotalWidth - .TextWidth) / .TextWidth(Chr(160))
            finalStr = String(Round(padCount), Chr(160)) & middleStr
        End With
        
        ' 写入单元格并设置右对齐格式
        ws.Cells(i + 1, "B").Value = finalStr
        ws.Cells(i + 1, "B").HorizontalAlignment = xlRight
    Next i
    
    ' 清理临时单元格
    ws.Range("B1").ClearContents
    
    MsgBox "对齐完成！"
End Sub

代码说明 #

• 原始数据需放在A列，对齐后的结果会自动写入B列；
• 用TextWidth精准计算字符显示宽度，适配Times-Roman比例字体的特性；
• 采用非断空格填充，保证空格宽度与数字、字母一致，确保对齐效果稳定；
• 自动遍历所有数据，批量处理，无需手动调整单个表格。

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