VBA中实现数组三层嵌套循环计算固定首值区间最小值的问题

实现方案 #

按新增第三层循环的思路实现 #

核心逻辑：对每一组区间起点j和区间终点i，遍历区间内所有元素，计算固定首值arr(j,1)减去当前元素的结果，保留最小值后写入输出数组。
修改后完整代码如下：

Dim arr, outarr As Variant
Dim lastc, lastr As Long
Dim ws As Worksheet
Set ws = ActiveSheet ' 可替换为你实际使用的工作表对象

lastc = 2
lastr = Cells(ws.Rows.Count, lastc).End(xlUp).Row
arr = Range(Cells(2, lastc), Cells(lastr, lastc))
cnt = ((UBound(arr, 1) - 1) * UBound(arr, 1)) / 2
k = 1
ReDim outarr(1 To cnt, 1 To 1)

For j = LBound(arr, 1) To UBound(arr, 1) - 1
    For i = j + 1 To UBound(arr, 1)
        Dim minVal As Double
        minVal = arr(j, 1) - arr(j, 1)
        ' 第三层循环遍历当前区间所有元素计算最小值
        For m = j To i
            curVal = arr(j, 1) - arr(m, 1)
            If curVal < minVal Then
                minVal = curVal
            End If
        Next m
        outarr(k, 1) = minVal
        k = k + 1
    Next i
Next j

性能优化版本（仅两层循环） #

固定首值的前提下，首值 - 区间内元素的最小值等价于首值 - 区间内元素的最大值，可以在遍历终点i的过程中同步记录当前区间的最大值，省去第三层循环，数据量大时性能提升明显：

Dim arr, outarr As Variant
Dim lastc, lastr As Long
Dim ws As Worksheet
Set ws = ActiveSheet

lastc = 2
lastr = Cells(ws.Rows.Count, lastc).End(xlUp).Row
arr = Range(Cells(2, lastc), Cells(lastr, lastc))
cnt = ((UBound(arr, 1) - 1) * UBound(arr, 1)) / 2
k = 1
ReDim outarr(1 To cnt, 1 To 1)

For j = LBound(arr, 1) To UBound(arr, 1) - 1
    Dim curMax As Double
    curMax = arr(j, 1) ' 初始化当前区间最大值
    For i = j + 1 To UBound(arr, 1)
        ' 同步更新区间最大值
        If arr(i, 1) > curMax Then
            curMax = arr(i, 1)
        End If
        ' 直接计算最小值
        outarr(k, 1) = arr(j, 1) - curMax
        k = k + 1
    Next i
Next j

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