使用Excel VBA评估方法返回/分析超出范围的每一行的移动数组

Question

VBA 评估方法对于数组公式可能很棘手，因为许多 Excel 函数本身并不接受数组作为参数，但它非常有用，因为它可以将循环或电子表格公式的处理时间加快几个数量级。例如，我使用 EVALUATE("INDEX(IF(1,N(OFFSET(...)") 习惯用法在几列上自动对齐由单独的数据记录器捕获的信号（数十万行）重新采样并最终对信号进行相关扫描。使用 VBA Evaluate 执行此操作只需几秒钟，而不是填充所需的小时，然后计算公式，然后手动移动数据...

我现在尝试在大范围的数据上使用 Evaluate 方法来加速峰值查找算法。我遇到的问题是，使用 VBA Evaluate 和直接在电子表格中溢出数组公式，只会为范围内的每一行返回第一个计算值或总体最大值。我相信这与我读过的有关如何使用 Evaluate 的许多其他问题类似，但我不知道如何将解决方案应用于我的案例。

所附图片显示了我基本上试图使用 B 列中的随机信号和填写 C 列和 D 列中的范围的电子表格公式来完成的示例。在该示例中，我已确定信号中的每个样本是否是 +/-100 ms（即 5 个样本）范围内的局部峰值。我在 C 列和 D 列中包含了两个不同的公式来识别峰值以说明多种通用方法：

在 C 列中填写：“= B3 = MAX(OFFSET(B$1,ROW()-3,0,5))” 在 D 列中填写：“= B3 = MAX(FILTER(B$3:B$51,(ROW(B$3:B$51)>=ROW() - 2)*(ROW(B$3:B$51)<=ROW()+2)))"

样品峰值检测

我无法回忆起我尝试过使其与 VBA 中的单个 Evaluate 操作一起使用的所有变体，但以下是一个小示例。与上图中的一般示例一样，假设信号数据位于 B 列中，并且我们正在识别 C 列中的峰值。下面的公式只是尝试返回峰值，而不是明确识别样本是否是峰值每行 +/- 2 个样本。

Sub EvalXmpl()

Dim LR as Long 'Last row

LR = .Range("A" & .Rows.count).End(xlUp).Row

With Worksheets(1)

  ' Example 1 - Returns MAX of overall range for every row
  .Range("C3:C" & LR) = .Evaluate("INDEX(IF(1,MAX(N(OFFSET(B1,ROW(C3:C" & LR & ") - 3,0,5)))),)")

  ' Example 2 - Returns MAX of overall range for every row
'  .Range("C3:C" & LR) = .Evaluate("IF(ROW(3:" & LR & "),MAX(N(OFFSET(B1,ROW(3:" & LR & ") - 3,0,5))))")

  ' Example 3 - Returns MAX of first calculation for every row
'  .Range("C3:C" & LR) = .Evaluate("INDEX(IF(1,MAX(FILTER(B3:B" & LR & ",(ROW(3:" & LR & _
      ") >= ROW()-2)*(ROW(3:" & LR & ") <= ROW()+2)))),)")

End With

End Sub

我尝试了所有这些的变体，看看是否可以强制数组正确返回。我认为有两件事可能让我陷入困境

1. 当 Evaluate 为每行返回单个值时，通过 INDEX() 或 IF(ROW()) 强制数组公式工作正常，但由于我在每行返回一个移动范围，因此强制效果不一样。
2. MAX 本身接受数组，因此它以某种方式否定了强制？

一些资源

• https://exceljet.net/formulas/return-array-with-index-function
• https://www.mrexcel.com/excel-tips/use-evaluate-in-vba-instead-of-looping-through-cells/
• https://newtonexcelbach.com/tag/evaluate/

Answer 1

移动阵列峰

主要

Sub MovingArrayPeaks()
    
    Const WORKSHEET_ID As Variant = 1
    Const SRC_FIRST_CELL As String = "B3"
    Const DST_COLUMN As String = "C"
    Const MOVING_ROWS As Long = 4

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Worksheets(WORKSHEET_ID)
    
    Dim rg As Range, rCount As Long
    
    With ws.Range(SRC_FIRST_CELL)
        rCount = ws.Cells(ws.Rows.Count, .Column).End(xlUp).Row - .Row + 1
        If rCount < 1 Then Exit Sub ' no data
        Set rg = .Resize(rCount)
    End With
    
    Dim Data() As Variant
    If rCount = 1 Then
        ReDim Data(1 To 1, 1 To 1): Data(1, 1) = rg.Value
    Else
        Data = rg.Value
    End If
    
    Dim rOffset As Long: rOffset = MOVING_ROWS - 1
    
    Dim r As Long
    
    For r = 1 To rCount Step MOVING_ROWS
        ReplaceDataWithMaxFlags Data, r, r + rOffset
    Next r

    With rg.EntireRow.Columns(DST_COLUMN)
        .Resize(rCount).Value = Data
        .Resize(ws.Rows.Count - .Row - rCount + 1).Offset(rCount).Clear
    End With

End Sub

帮助

Sub ReplaceDataWithMaxFlags( _
        Data() As Variant, _
        ByVal IndexLo As Long, _
        ByVal IndexHi As Long, _
        Optional ByVal FlagMax As Variant = True, _
        Optional ByVal FlagNotMax As Variant = False)
    
    If IndexHi > UBound(Data, 1) Then IndexHi = UBound(Data, 1)
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    
    Dim Value As Variant, Key As Variant, r As Long
    Dim IsFirstFound As Boolean, IsGreater As Boolean
    
    For r = IndexLo To IndexHi
        Value = Data(r, 1)
        If VarType(Value) = vbDouble Then
            If IsFirstFound Then
                For Each Key In dict.Keys
                    Select Case dict(Key)
                        Case Is < Value
                            IsGreater = True
                            dict.Remove Key
                        Case Value
                            dict(r) = Value
                            Exit For
                    End Select
                Next Key
                If IsGreater Then
                    IsGreater = False
                    dict(r) = Value
                End If
            Else
                dict(r) = Value
                IsFirstFound = True
            End If
        End If
    Next r
    
    For r = IndexLo To IndexHi
        If dict.Exists(r) Then
            Data(r, 1) = FlagMax
        Else
            Data(r, 1) = FlagNotMax
        End If
    Next r
               
End Sub