Hey there, let's break down the issues you're facing step by step and fix them up!

首先，分析424错误的根源 #

你遇到的424错误（对象要求）主要有两个核心原因：

• ExtractNumber函数鲁棒性不足：当字符串中没有数字时（比如示例里的Big Steer Restaurant），原函数会返回空值，执行CDbl(lNum)时就会触发错误。
• 数组下标越界问题：你的stored数组初始化有误，导致循环时访问了不存在的下标，间接引发错误。

修正后的ExtractNumber函数 #

先更新这个函数，让它能处理无数字的情况，返回0而不是引发错误：

Function ExtractNumber(rCell As String) As Double
    Dim lNum As String, lChar As String
    Dim i As Integer
    
    If rCell = "" Then
        ExtractNumber = 0
        Exit Function
    End If
    
    For i = 1 To Len(rCell)
        lChar = Mid(rCell, i, 1)
        If IsNumeric(lChar) Then
            lNum = lNum & lChar
        End If
    Next i
    
    ' 如果没有提取到数字，返回0
    If lNum = "" Then
        ExtractNumber = 0
    Else
        ExtractNumber = CDbl(lNum)
    End If
End Function

修正主程序Divide的问题 #

你的主程序还有几个逻辑错误，比如数组下标越界、判断条件错误、数组赋值不当等，下面是修正后的完整代码：

Option Explicit
Sub Divide()
    Dim txt As String
    Dim i As Integer
    Dim j As Integer
    Dim Full As Variant
    Dim a As Integer
    Dim stored() As Double ' 改用Double避免数字溢出，同时兼容无数字的情况
    Dim primary_index As Integer
    Dim primary_no As Double
    Dim primary_name As String
    Dim secondary_index As Integer
    Dim secondary_no As Double
    Dim secondary_name As String
    Dim remainingNames As String
    Dim totalOriginal As Double
    
    ' 获取当前单元格内容并拆分
    txt = CStr(ActiveCell.Value)
    Full = Split(Trim(txt), ";")
    ' 去除每个元素前后的空格
    For i = LBound(Full) To UBound(Full)
        Full(i) = Trim(Full(i))
    Next i
    
    a = UBound(Full)
    ' 初始化stored数组，长度和Full一致
    ReDim stored(LBound(Full) To a)
    
    ' 提取每个名称的数字
    For i = LBound(Full) To a
        stored(i) = ExtractNumber(Full(i))
    Next i
    
    ' 找到数字最大的主项
    primary_no = Application.Max(stored)
    primary_index = Application.Match(primary_no, stored, 0) - 1 ' Match返回1-based索引，转0-based
    primary_name = Full(primary_index)
    stored(primary_index) = 0 ' 重置为0，方便找次项
    
    ' 初始化次项变量
    secondary_no = 0
    secondary_name = ""
    
    ' 找到数字第二大的次项（如果有多个元素）
    If a >= 1 Then ' 当元素数量>=2时才找次项
        secondary_no = Application.Max(stored)
        secondary_index = Application.Match(secondary_no, stored, 0) - 1
        secondary_name = Full(secondary_index)
        stored(secondary_index) = 0
    End If
    
    ' 计算剩余名称的拼接和剩余数字总和
    remainingNames = ""
    totalOriginal = Application.Sum(stored) + primary_no + secondary_no
    For i = LBound(Full) To a
        If stored(i) <> 0 Then
            If remainingNames <> "" Then remainingNames = remainingNames & "; "
            remainingNames = remainingNames & Full(i)
        End If
    Next i
    
    ' 插入需要的列（这里插入7列，对应后续的7个字段）
    ActiveCell.EntireColumn.Offset(0, 1).Resize(, 7).Insert Shift:=xlToRight
    
    ' 赋值到对应单元格
    ActiveCell.Offset(0, 1).Value = primary_name
    ActiveCell.Offset(0, 2).Value = primary_no
    ActiveCell.Offset(0, 3).Value = secondary_name
    ActiveCell.Offset(0, 4).Value = secondary_no
    ActiveCell.Offset(0, 5).Value = remainingNames
    ActiveCell.Offset(0, 6).Value = totalOriginal - primary_no - secondary_no
End Sub

关键修正点说明 #

• 数组下标修复：原代码中ReDim stored(b)（b=a-1）导致数组长度比Full少1，循环时会越界，现在改为和Full同长度的数组。
• 索引转换：Application.Match返回的是1-based索引，需要减1转换为VBA数组的0-based索引，避免取错元素。
• 鲁棒性提升：处理了无数字的名称，拆分后自动去除每个元素的前后空格，避免空字符串干扰。
• 剩余名称处理：原代码中直接赋值数组到单元格会显示错误，改为拼接成字符串后赋值。
• 变量类型优化：将数字变量改为Double，避免Integer的溢出风险（虽然示例中数字不大，但更通用）。

测试示例数据 #

用你提供的示例数据测试，这个代码会：

1. 提取出数字最大的Subway (231)放在第一列，数字231在第二列
2. 第二大的Cinnabon (126)放在第三列，数字126在第四列
3. 剩余所有名称拼接成字符串放在第五列
4. 剩余数字总和放在第六列

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