VBA代码修改请求：修正非连续区域跨工作表求和粘贴格式

我来帮你搞定这个问题！你遇到的核心问题是：当选中非连续单元格区域时，Selection.Address(0,0)返回的地址格式是A1,A3这种，只会在开头统一带一次工作表名，而不是每个区域都单独带。所以跨表粘贴时，后面的单元格会被当成当前工作表的，就不符合预期了。

修改思路 #

我们需要遍历选中区域里的每一个独立区域（Area），给每个区域都手动加上工作表名称和感叹号，然后把这些带表名的地址用逗号拼接起来，再放到SUM公式里。

修改后的完整代码 #

Sub CopySum()
    Dim ObjData As New DataObject
    Dim areaRange As Range
    Dim sumAddresses As String
    
    ObjData.Clear
    sumAddresses = ""
    
    ' 遍历选中的每一个独立区域
    For Each areaRange In Selection.Areas
        ' 给每个区域加上工作表名和感叹号，再拼接地址
        If sumAddresses <> "" Then
            sumAddresses = sumAddresses & ","
        End If
        sumAddresses = sumAddresses & "'" & Selection.Parent.Name & "'!" & areaRange.Address(0, 0)
    Next areaRange
    
    ' 生成求和公式并放入剪贴板
    ObjData.SetText "+sum(" & sumAddresses & ")"
    ObjData.PutInClipboard
End Sub

关键部分解释 #

• Selection.Areas：获取选中区域里的所有独立连续区域，比如选中A1和A3时，会返回两个Area对象，分别对应A1和A3。
• 循环拼接每个Area的地址：每次循环都给当前Area的地址加上'工作表名'!前缀，然后用逗号连接所有处理后的地址，这样每个区域都有自己的工作表名前缀。
• 最后把拼接好的地址放入SUM公式，再写入剪贴板。

现在测试一下：选中Sheet1里的A1和A3，运行这个宏后，剪贴板里的内容会是+sum('Sheet1'!A1,'Sheet1'!A3)，跨工作表粘贴时就能生成正确的求和公式啦！

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