求助：Excel宏拆分单元格后按拆分数量均分Budget值

我帮你调整了宏代码，现在既能完成多值单元格的拆分，还能自动把对应Budget按拆分后的条目数量均分，完美匹配你的期望输出。

先明确数据对应关系 #

你的原始数据应该是这样的（修正排版后）：

期望输出：

修改后的完整宏代码 #

Sub SplitAndAllocateBudget()
    ' 复制当前工作表到最后，不破坏原始数据
    ActiveSheet.Copy After:=Sheets(Sheets.Count)
    Dim ws As Worksheet
    Set ws = ActiveSheet ' 指向新生成的工作表，避免误操作原表
    
    Dim tmpArr As Variant
    Dim Cell As Range
    Dim splitCount As Integer
    Dim originalBudget As Double
    Dim allocatedBudget As Double
    
    ' 遍历Customer列（这里用你宏里的AE列，如果你实际是A列，替换成Range("A1", ws.Range("A" & ws.Rows.Count).End(xlUp))）
    For Each Cell In ws.Range("AE1", ws.Range("AE" & ws.Rows.Count).End(xlUp))
        ' 检查单元格是否包含Alt+Enter的换行符
        If InStr(1, Cell.Value, Chr(10)) <> 0 Then
            ' 拆分单元格内容为数组
            tmpArr = Split(Cell.Value, Chr(10))
            splitCount = UBound(tmpArr) + 1 ' 获取拆分后的条目总数
            
            ' 获取当前行的Budget值（如果Customer是AE列，Budget就是AF列；如果是A列，就是B列，对应Offset(0,1)）
            originalBudget = Cell.Offset(0, 1).Value
            
            ' 计算均分后的Budget，处理特殊情况（比如Budget为0）
            If splitCount > 0 And originalBudget <> 0 Then
                allocatedBudget = originalBudget / splitCount
            Else
                allocatedBudget = 0
            End If
            
            ' 插入需要的空行（拆分后条目数-1行，原行保留）
            Cell.EntireRow.Copy
            Cell.Offset(1, 0).Resize(splitCount - 1, 1).EntireRow.Insert xlShiftDown
            
            ' 将拆分后的Customer值填充到对应行
            Cell.Resize(splitCount, 1).Value = Application.Transpose(tmpArr)
            
            ' 把均分后的Budget填充到所有拆分出来的行
            Cell.Offset(0, 1).Resize(splitCount, 1).Value = allocatedBudget
            
            ' 标记原行（可选，方便识别）
            Cell.EntireRow.Interior.Color = RGB(120, 120, 225)
        End If
    Next Cell
    
    Application.CutCopyMode = False
    MsgBox "拆分和Budget均分完成！", vbInformation
End Sub

关键修改说明 #

• 新增Budget均分逻辑：通过splitCount获取拆分后的条目数，用原始Budget除以这个数得到每份金额，再批量填充到所有拆分行；
• 明确工作表对象：用ws变量指向新复制的工作表，避免误操作原始数据；
• 适配列位置：如果你实际数据是A列（Customer）和B列（Budget），只需要把代码里的AE替换成A即可，Offset(0,1)会自动对应B列；
• 异常处理：考虑了Budget为0或拆分后无条目的情况，避免报错；

使用方法 #

1. 打开你的Excel文件，按下Alt+F11打开VBA编辑器；
2. 插入新模块，把上面的代码粘贴进去；
3. 回到Excel，运行这个宏即可，结果会自动生成在新工作表里。

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