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

6jjcrrmo 于 2023-08-08 发布在其他

关注(0)|答案(1)|浏览(126)

我有一个工作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代码后：

的

excel

来源：https://stackoverflow.com/questions/76820088/min-and-max-values-of-a-dynamic-range-in-a-vba-array

1条答案

按热度按时间

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

型

赞(0）回复(0）举报 2023-08-08

我来回答

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

1条答案

相关问题

热门标签

最新问答