VBA遍历双列表时目标单元格偏移错误求助

问题场景 #

需要从PL_GROWTH(CUSTOM)工作表读取指定单元格的值，除以1000后写入目标工作表的对应单元格。已定义源和目标的单元格列表，但遍历过程中出现偏移：本该将PL_GROWTH(CUSTOM)!CN99的值写入C16，实际却写入了B17。

预期的对应关系：

B16 = 'PL_GROWTH(CUSTOM)'!CN88/1000
C16 = 'PL_GROWTH(CUSTOM)'!CN99/1000
D16 = 'PL_GROWTH(CUSTOM)'!CN76/1000

相关代码 #

Sub UpdateMGMT(ws As Worksheet)
    Dim sourceRangeGrowth As Range, targetRangeGrowth As Range, j As Integer
    
    ' Set up the source and target ranges
    Set sourceRangeGrowth = Sheets("PL_GROWTH(CUSTOM)").Range("CN88,CN99,CN76,CN110,CN191,CN191,CN253,CN67,CN307,CN307,CN94,CN105,CN82,CN116,CN192,CN192,CN254,CN308,CN308,CN95,CN106,CN83,CN117,CN193,CN193,CN255,CN309,CN309")
    Set targetRangeGrowth = ws.Range("B16,C16,D16,G16,H16,J16,O16,P16,Q16,S16,B18,C18,D18,G18,H18,J18,O18,Q18,S18,B19,C19,D19,G19,H19,J19,O19,Q19,S19")
    
    ' Copy data from source to target, handling division by zero errors
    j = 1
    For Each cell In sourceRangeGrowth
        Debug.Print "Copying data from cell " & cell.Address(False, False) & " (value: " & cell.Value & ") to cell " & targetRangeGrowth(j).Address(False, False)
        If cell.Value = 0 Then
            targetRangeGrowth(j).Value = 0
            Debug.Print "Value copied: 0"
        Else
            targetRangeGrowth(j).Value = cell.Value / 1000
            Debug.Print "Value copied: " & targetRangeGrowth(j).Value
        End If
        j = j + 1
    Next cell
End Sub

运行日志 #

Copying data from cell CN88 (value: 147905.714482528) to cell B16
Value copied: 147.905714482528

Copying data from cell CN99 (value: 111501.254016756) to cell B17
Value copied: 111.501254016756

问题原因 #

当使用逗号分隔多个单个单元格创建Range对象时，VBA会自动将这些单元格按工作表的自然顺序（行优先、列优先）重新排序，而非保持你定义的顺序。此时targetRangeGrowth(j)取的是排序后Cells集合的第j个元素，不是你最初定义的第j个目标单元格。

比如你定义的目标顺序是B16,C16,D16,...B18,...，但VBA实际排序后的顺序是B16,B18,B19,C16,C18,C19,...，直接导致索引偏移。

解决方案 #

方案1：使用Areas集合按定义顺序访问目标单元格 #

用逗号分隔的单个单元格会被拆分为多个Area（每个Area对应一个单元格），Areas(j)会严格按照你定义的顺序返回第j个单元格。

修改后的代码：

Sub UpdateMGMT(ws As Worksheet)
    Dim sourceRangeGrowth As Range, targetRangeGrowth As Range, j As Integer
    Dim sourceCell As Range, targetCell As Range
    
    ' Set up the source and target ranges
    Set sourceRangeGrowth = Sheets("PL_GROWTH(CUSTOM)").Range("CN88,CN99,CN76,CN110,CN191,CN191,CN253,CN67,CN307,CN307,CN94,CN105,CN82,CN116,CN192,CN192,CN254,CN308,CN308,CN95,CN106,CN83,CN117,CN193,CN193,CN255,CN309,CN309")
    Set targetRangeGrowth = ws.Range("B16,C16,D16,G16,H16,J16,O16,P16,Q16,S16,B18,C18,D18,G18,H18,J18,O18,Q18,S18,B19,C19,D19,G19,H19,J19,O19,Q19,S19")
    
    ' Copy data from source to target, handling division by zero errors
    j = 1
    For Each sourceCell In sourceRangeGrowth
        ' 按定义的顺序获取目标单元格
        Set targetCell = targetRangeGrowth.Areas(j)
        Debug.Print "Copying data from cell " & sourceCell.Address(False, False) & " (value: " & sourceCell.Value & ") to cell " & targetCell.Address(False, False)
        If sourceCell.Value = 0 Then
            targetCell.Value = 0
            Debug.Print "Value copied: 0"
        Else
            targetCell.Value = sourceCell.Value / 1000
            Debug.Print "Value copied: " & targetCell.Value
        End If
        j = j + 1
    Next sourceCell
End Sub

方案2：用数组存储单元格地址直接定位 #

如果目标单元格数量较多，直接用数组存储源和目标的单元格地址，遍历数组时通过地址定位单元格，完全避免Range排序问题。

代码示例：

Sub UpdateMGMT(ws As Worksheet)
    Dim sourceAddrs As Variant, targetAddrs As Variant
    Dim i As Integer, sourceVal As Double
    
    ' 存储源和目标单元格地址数组
    sourceAddrs = Array("CN88", "CN99", "CN76", "CN110", "CN191", "CN191", "CN253", "CN67", "CN307", "CN307", "CN94", "CN105", "CN82", "CN116", "CN192", "CN192", "CN254", "CN308", "CN308", "CN95", "CN106", "CN83", "CN117", "CN193", "CN193", "CN255", "CN309", "CN309")
    targetAddrs = Array("B16", "C16", "D16", "G16", "H16", "J16", "O16", "P16", "Q16", "S16", "B18", "C18", "D18", "G18", "H18", "J18", "O18", "Q18", "S18", "B19", "C19", "D19", "G19", "H19", "J19", "O19", "Q19", "S19")
    
    ' 遍历数组复制数据
    For i = LBound(sourceAddrs) To UBound(sourceAddrs)
        sourceVal = Sheets("PL_GROWTH(CUSTOM)").Range(sourceAddrs(i)).Value
        Debug.Print "Copying data from cell " & sourceAddrs(i) & " (value: " & sourceVal & ") to cell " & targetAddrs(i)
        If sourceVal = 0 Then
            ws.Range(targetAddrs(i)).Value = 0
            Debug.Print "Value copied: 0"
        Else
            ws.Range(targetAddrs(i)).Value = sourceVal / 1000
            Debug.Print "Value copied: " & ws.Range(targetAddrs(i)).Value
        End If
    Next i
End Sub

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