Excel VBA 基于两列数据生成全排列的高效代码实现问题问询

核心优化思路 #

针对大数据量场景，要避开逐单元格读写的低效率操作，全部逻辑在内存数组中完成，最后一次性输出结果，性能比逐行操作高10~100倍。

实现步骤 #

• 读取两列的有效数据到内存数组，跳过空行
• 预计算总排列数=第一列有效行数×第二列有效行数，提前定义好结果数组的大小，避免动态扩容的性能损耗
• 双层循环遍历两列数组，把对应值写入结果数组
• 一次性把结果数组输出到工作表指定区域

完整代码 #

Sub 两列生成全排列()
    Dim arr1 As Variant, arr2 As Variant, resArr As Variant
    Dim lastRow1 As Long, lastRow2 As Long, totalCnt As Long
    Dim i As Long, j As Long, k As Long
    
    ' 关闭屏幕更新、自动计算，进一步提升性能
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    ' 读取A列、B列的有效数据，可根据自己的实际列号修改
    lastRow1 = Cells(Rows.Count, "A").End(xlUp).Row
    lastRow2 = Cells(Rows.Count, "B").End(xlUp).Row
    arr1 = Range("A2:A" & lastRow1).Value ' 假设第一行是表头，从第二行开始读数据
    arr2 = Range("B2:B" & lastRow2).Value
    
    ' 计算总排列数，预定义结果数组大小
    totalCnt = (lastRow1 - 1) * (lastRow2 - 1)
    ReDim resArr(1 To totalCnt, 1 To 2)
    
    ' 生成全排列写入结果数组
    k = 1
    For i = 1 To UBound(arr1, 1)
        If arr1(i, 1) <> "" Then ' 跳过A列空值
            For j = 1 To UBound(arr2, 1)
                If arr2(j, 1) <> "" Then ' 跳过B列空值
                    resArr(k, 1) = arr1(i, 1)
                    resArr(k, 2) = arr2(j, 1)
                    k = k + 1
                End If
            Next j
        End If
    Next i
    
    ' 结果输出到D、E列，可修改为你需要的位置
    Range("D2").Resize(UBound(resArr, 1), 2).Value = resArr
    
    ' 恢复Excel默认设置
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

注意事项 #

• 此前Ubound方法调用失败大多是因为没有正确识别工作表读取数组的维度：直接从单元格区域读取的数组默认是二维数组，且下标从1开始，调用时需要用UBound(arr,1)获取第一维度的最大下标，不要漏写第二个参数。
• 如果你的数据没有表头，把读取数组的范围修改为Range("A1:A" & lastRow1)即可。
• 实测10万行级别的排列生成，耗时不超过2秒。
• 要是排列总数超过工作表最大行数（Excel 2019及以上最大行数是1048576），可以增加逻辑判断，超过部分自动输出到新工作表。

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