如何按工作表中单元格/区域引用顺序遍历命名区域并存入字典？

我有一个工作表，表头"Sum1""Sum2"等属于名为"X_Name"的命名区域（工作表中不直接显示"X_Name"）。我需要遍历所有命名区域并添加到字典中，但要按命名区域在工作表中出现的顺序遍历，而非按命名区域名称的字母顺序，以此保留顺序。比如现有代码生成的字典顺序是A_Name:I2:K2、B_Name:A2:C2、C_Name:E2:G2，但我期望的顺序是B_Name:A2:C2、C_Name:E2:G2、A_Name:I2:K2。

当前生成无序字典的代码：

For Each namedRangeStr In ws.Names
    'namedRangeStr needs to be converted to Range object
    
    Set namedRangeRng = range(namedRangeStr)
   
    basisDict.Add namedRangeStr, namedRangeRng
    
Next namedRangeStr

解决方案 #

VBA的Names集合默认按名称字母顺序返回，要实现按工作表位置排序，需先提取命名区域的位置信息排序，再填充字典：

Sub SortNamedRangesByPosition()
    Dim ws As Worksheet
    Dim basisDict As Object
    Dim namedRngArr() As Variant
    Dim i As Integer, j As Integer
    Dim tempName As String, tempRng As Range
    
    Set ws = ActiveSheet ' 替换为你的目标工作表
    Set basisDict = CreateObject("Scripting.Dictionary")
    
    ' 将所有命名区域存入二维数组（存储名称和对应Range）
    ReDim namedRngArr(1 To ws.Names.Count, 1 To 2)
    For i = 1 To ws.Names.Count
        namedRngArr(i, 1) = ws.Names(i).Name
        Set namedRngArr(i, 2) = ws.Names(i).RefersToRange
    Next i
    
    ' 按区域起始单元格的列号升序排序，列相同则按行号升序
    For i = 1 To UBound(namedRngArr, 1) - 1
        For j = i + 1 To UBound(namedRngArr, 1)
            If namedRngArr(i, 2).Column > namedRngArr(j, 2).Column Or _
               (namedRngArr(i, 2).Column = namedRngArr(j, 2).Column And _
                namedRngArr(i, 2).Row > namedRngArr(j, 2).Row) Then
                ' 交换名称
                tempName = namedRngArr(i, 1)
                namedRngArr(i, 1) = namedRngArr(j, 1)
                namedRngArr(j, 1) = tempName
                ' 交换Range对象
                Set tempRng = namedRngArr(i, 2)
                Set namedRngArr(i, 2) = namedRngArr(j, 2)
                Set namedRngArr(j, 2) = tempRng
            End If
        Next j
    Next i
    
    ' 将排序后的内容添加到字典
    For i = 1 To UBound(namedRngArr, 1)
        basisDict.Add namedRngArr(i, 1), namedRngArr(i, 2)
    Next i
    
    ' 验证输出（可删除）
    For Each key In basisDict.Keys
        Debug.Print key & ":" & basisDict(key).Address
    Next key
End Sub

说明 #

• 以命名区域的左上角单元格作为排序依据，保证按工作表中从左到右、从上到下的顺序排列
• 若命名区域跨行列，该逻辑依然适用，符合常规的"出现顺序"认知
• 代码中ActiveSheet需替换为你的目标工作表对象

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