excel VBA数组中动态范围的最小值和最大值

6jjcrrmo  于 2023-08-08  发布在  其他
关注(0)|答案(1)|浏览(137)

我有一个工作VBA代码,它从B列(58000行)中的一个范围创建一个数组(arr),将其拆分为一个仅包含原始数组中的负值的数组(arr 1)和另一个仅包含原始数组中的正值的数组(arr 2)。数组“arr 1”和“arr 2”分别写入列C和D。在E列和“AdjustFactor”(F列和G列)中给出的所选时间范围被放入For循环中,以便我可以从每个范围中获得最小值和最大值,并将这些值写回H列和I列。
我想做的是搜索相同的min和max值,而不将arr 1和arr 2写入Worksheet,即直接在arr 1和arr 2中搜索min和max。
有人知道怎么做吗?
在此先谢谢您!

Sub Macro1()

Dim i, j, LastRow As Long
Dim arr, arr1, arr2, Time, NegativeRange, PositiveRange, NegativeMin, PositiveMin, AdjustFactor As Variant

    With Sheets("Rawdata")
        
        i = .Cells(.Rows.Count, 1).End(xlUp).Row
        arr = .Cells(1, 2).Resize(i, 1).Value
        arr1 = .Cells(1, 3).Resize(i, 1)
        arr2 = .Cells(1, 4).Resize(i, 1)
                
        For i = LBound(arr, 1) To UBound(arr, 1)
            arr1(i, 1) = IIf(arr(i, 1) >= 0, vblank, arr(i, 1))
            arr2(i, 1) = IIf(arr(i, 1) < 0, vblank, arr(i, 1))
        Next i
                
        .Cells(1, 3).Resize(i - 1, 1) = arr1
        .Cells(1, 4).Resize(i - 1, 1) = arr2
    
    End With
    
    LastRow = Cells(Rows.Count, 5).End(xlUp).Row
    
    AdjustFactor = Range(Cells(1, 6), Cells(LastRow, 7))
    
    PositiveMin = Range(Cells(1, 8), Cells(LastRow, 8))
    NegativeMin = Range(Cells(1, 9), Cells(LastRow, 9))
    
    For j = 1 To LastRow

        Time = Range("A:A").Find(what:=Cells(j, 5).Value, LookIn:=xlValues, LookAt:=1, MatchCase:=True).Row
        PositiveRange = Range(Cells(Time + 10 * AdjustFactor(j, 1), 4), Cells(Time + 10 * AdjustFactor(j, 2), 4))
        NegativeRange = Range(Cells(Time + 10 * AdjustFactor(j, 1), 3), Cells(Time + 10 * AdjustFactor(j, 2), 3))
        PositiveMin(j, 1) = WorksheetFunction.Min(PositiveRange)
        NegativeMin(j, 1) = WorksheetFunction.Max(NegativeRange)

    Next j

    Range(Cells(1, 8), Cells(LastRow, 8)) = PositiveMin
    Range(Cells(1, 9), Cells(LastRow, 9)) = NegativeMin

End Sub

字符串
运行VBA代码之前:
x1c 0d1x的数据
运行VBA代码后:


nzk0hqpo

nzk0hqpo1#

问题:我想做的是搜索相同的min和max值,而不将arr1和arr2写入Worksheet,即直接在arr1和arr2中搜索min和max
答:通过在源数组上使用WorksheetFunction.Index,您可以将切片结果放入新的数组变量中,而无需任何中间步骤(写入单元格)。

Dim lStart As Long, lEnd As Long, vaPosi, vaNega
    For j = 1 To LastRow
        Time = Range("A:A").Find(what:=Cells(j, 5).Value, LookIn:=xlValues, LookAt:=1, MatchCase:=True).Row
        lStart = Time + 10 * AdjustFactor(j, 1)
        lEnd = Time + 10 * AdjustFactor(j, 2)
        vaPosi = Application.Index(Arr2, Evaluate("ROW(" & lStart & ":" & lEnd & ")"), Array(1))
        vaNega = Application.Index(Arr1, Evaluate("ROW(" & lStart & ":" & lEnd & ")"), Array(1))
        PositiveMin(j, 1) = WorksheetFunction.Min(vaPosi)
        NegativeMin(j, 1) = WorksheetFunction.Max(vaNega)
    Next j

字符串
代码片段演示了使用WorksheetFunction.Index进行数组切片。

Sub demo()
    Dim srcArr(1 To 4, 1 To 4) As Variant, slicedArr As Variant
    Dim i As Long, j As Long
    For i = LBound(srcArr, 1) To UBound(srcArr, 1)
        For j = LBound(srcArr, 2) To UBound(srcArr, 2)
            srcArr(i, j) = i * j
        Next j
    Next i
    ' get three rows x two columns
    slicedArr = Application.Index(srcArr, Evaluate("ROW(1:3)"), Array(1, 2))
    Debug.Print "Index1", "Index2", "slicedArr(i, j)"
    For i = LBound(slicedArr, 1) To UBound(slicedArr, 1)
        For j = LBound(slicedArr, 2) To UBound(slicedArr, 2)
            Debug.Print i, j, slicedArr(i, j)
        Next j
    Next i
End Sub

相关问题