VBA列操作代码修改请求：按指定列规则重写数组逻辑

没问题，我帮你把这段VBA代码调整好，完全贴合你说的列映射要求，数组相关的逻辑也都处理到位了：

Dim Ary As Variant, Nary As Variant
Dim r As Long, Rw As Long
With Sheets("Sheet1")
    ' 原A列→D列，原B列→N列，所以数据源改为D2:N
    Ary = .Range("D2:N" & .Range("D" & Rows.Count).End(xlUp).Row).Value2
End With
' 保持数组行数和原数据源一致，列数还是1列（用于汇总结果）
ReDim Nary(1 To UBound(Ary), 1 To 1)
With CreateObject("scripting.dictionary")
    For r = 1 To UBound(Ary)
        If Not .Exists(Ary(r, 1)) Then
            .Add Ary(r, 1), r
            Nary(r, 1) = Ary(r, 2)
        Else
            Rw = .Item(Ary(r, 1))
            Nary(Rw, 1) = Nary(Rw, 1) + Ary(r, 2)
        End If
    Next r
End With
' 原C列→O列，所以结果输出到O2开始的区域
Sheets("sheet1").Range("O2").Resize(UBound(Nary)).Value = Nary

修改关键点说明 #

• 数据源范围：把原来的A2:B替换成D2:N，完美对应你要求的原A列→D列、原B列→N列的映射关系
• 结果输出位置：从C2改成O2，匹配原C列→O列的需求
• 数组逻辑：UBound(Ary)这类函数不需要调整，因为它们是基于数组的行数维度计算的，我们只是替换了数据源的列，数组的行结构和原来完全一致，所以这些函数的用法保持原样就可以正常工作
• 数组索引：Ary(r,1)现在对应D列的内容，Ary(r,2)对应N列的内容，逻辑和原代码中A、B列的处理完全一致，保证汇总逻辑不变

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