如何修改VBA代码实现数字的一位数Cross Sum（横加数）计算

原代码仅能计算初次横加数，要实现最终得到一位数的需求，我们可以通过循环迭代或利用数字根的数学特性来完成。以下是两种可行的修改方案：

方案一：循环迭代计算 #

通过重复计算横加数，直到结果变为一位数，逻辑直观易懂：

Sub quersumme()
    Dim originalNum As Long
    Dim crossSum As Long
    
    ' 获取A1单元格的数值
    originalNum = Cells(1, 1).Value
    
    ' 计算初始横加数
    crossSum = 0
    Do While originalNum > 0
        crossSum = crossSum + originalNum Mod 10
        originalNum = originalNum \ 10
    Loop
    
    ' 循环处理，直到结果为一位数
    Do While crossSum >= 10
        Dim tempSum As Long
        tempSum = 0
        Do While crossSum > 0
            tempSum = tempSum + crossSum Mod 10
            crossSum = crossSum \ 10
        Loop
        crossSum = tempSum
    Loop
    
    ' 将结果写入B1单元格
    Cells(1, 2) = crossSum
End Sub

代码要点： #

• 改用Long类型替代Integer，避免处理大数时溢出（Integer最大仅能存储32767）
• 通过取余（Mod）和整除（\）计算横加数，比字符串截取的方式更高效、更稳定
• 移除On Error Resume Next，避免隐藏潜在错误（如需处理非数值输入，可额外添加错误判断）

方案二：利用数字根数学特性（更简洁） #

根据数论中的数字根规则：

• 若数字为0，数字根是0
• 若数字是9的倍数且不为0，数字根是9
• 其余情况，数字根为数字对9取余

基于此可以写出极简代码：

Sub quersumme_Short()
    Dim num As Long
    num = Cells(1, 1).Value
    
    If num = 0 Then
        Cells(1, 2) = 0
    Else
        Cells(1, 2) = (num - 1) Mod 9 + 1
    End If
End Sub

代码要点： #

• 无需循环，直接通过数学公式得到结果，效率极高
• 单独处理num=0的特殊情况，避免公式返回错误结果

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