VBA宏多区域随机排序异常：仅单区域生效且.Apply处报错

原代码存在的问题 #

• 语法缺失：For i = 1 To 5循环未添加Next i，导致代码执行到.Apply时中断
• 逻辑错误：将所有区域的排序字段一次性添加到工作表的Sort对象，无法实现多区域独立排序
• 变量误用：sortRange1~sortRange5是独立变量，并非数组，sortRange(i)的调用方式无效
• 方法错误：普通的升序排序无法实现随机打乱效果，必须借助随机数辅助列

修正后的完整代码 #

Sub AutoShuffle()
    Dim ws As Worksheet
    Dim sortRanges As Variant
    Dim i As Integer
    Dim tempCol As Range
    Dim targetRange As Range
    
    ' 指定目标工作表
    Set ws = ActiveWorkbook.Worksheets("Names")
    
    ' 将需要排序的区域存入数组，方便批量处理
    sortRanges = Array( _
        ws.Range("J2:M9"), _
        ws.Range("N2:Q5"), _
        ws.Range("R2:U14"), _
        ws.Range("V2:Y13"), _
        ws.Range("Z2:AC14") _
    )
    
    ' 遍历每个区域进行随机排序
    For i = LBound(sortRanges) To UBound(sortRanges)
        Set targetRange = sortRanges(i)
        
        ' 在目标区域右侧插入临时辅助列
        Set tempCol = targetRange.Offset(0, targetRange.Columns.Count).Resize(targetRange.Rows.Count, 1)
        
        ' 给辅助列填充随机数（用于随机排序依据）
        tempCol.Formula = "=RAND()"
        tempCol.Value = tempCol.Value ' 将公式转为值，避免后续重新计算
        
        ' 按辅助列的随机数进行排序
        With ws.Sort
            .SortFields.Clear
            .SortFields.Add2 Key:=tempCol, _
                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SetRange targetRange.Resize(targetRange.Rows.Count, targetRange.Columns.Count + 1)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        
        ' 删除临时辅助列
        tempCol.Delete
    Next i
End Sub

代码说明 #

1. 区域数组化：将所有需要排序的区域存入数组，通过循环批量处理，简化代码结构
2. 临时辅助列：每个区域右侧插入临时列生成随机数，作为随机排序的依据
3. 独立排序：每个区域单独执行排序逻辑，排序完成后删除临时列，不影响原数据结构
4. 语法修正：补全循环的Next语句，确保代码正常执行

使用方法 #

1. 将上述代码替换原宏代码
2. 在工作表中添加按钮，将宏AutoShuffle绑定到按钮上
3. 点击按钮即可完成所有指定区域的随机打乱

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