多阵列计算答案

【问题标题】：Multiple Array Calculations多阵列计算
【发布时间】：2021-10-30 04:25:06
【问题描述】：

下面的脚本会运行数组差异计算，然后在满足其他条件时进一步处理数据。在将最终输出记录到 Sheet1 之前，我需要添加一个额外的标准来进一步过滤数据。需要在“K”列中添加“位置”，以便在将数据记录到 Sheet1 之前先过滤数据。

模块 1 中的代码

Public Sub PopulateMyArr()
myArr = Sheet4.Range("I6:I500").Value
End Sub

本工作簿中的代码

Private Sub Workbook_Open()
PopulateMyArr
End Sub

Sheet4 中的代码 (BA_Size)

Private Sub Worksheet_Calculate()

Dim keyCells As Range, i As Long, diff, cKey As Range

'exit if togglebutton not on
If Not Worksheets("BA_Size").ToggleButton1.Value Then Exit Sub

On Error GoTo safeexit
Application.EnableEvents = False

Set keyCells = Me.Range("I6:I500")
nextrow = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row + 1

For i = 1 To UBound(myArr)
    Set cKey = keyCells(i, 1)
    If cKey.Value <> myArr(i, 1) Then
        diff = (cKey.Value - myArr(i, 1))
        'check value in Col L
        Select Case cKey.EntireRow.Columns("L").Value
            Case "John": diff = diff * cKey.EntireRow.Columns("O").Value
            Case "Mary": diff = diff * cKey.EntireRow.Columns("P").Value
            Case Else: diff = 0
        End Select
        Sheet1.Cells(nextrow, "A").Value = diff
        nextrow = nextrow + 1
    End If
Next i
  
safeexit:
PopulateMyArr
Application.EnableEvents = True
End Sub

【问题讨论】：

我不明白你的问题是什么。你不是已经在上面的 AB 栏中得到了你需要的东西吗？您需要什么帮助？
列 AB 模拟显示输出应该是什么。上面的脚本在没有 K 列的情况下工作。我需要它与添加的 K 列逻辑一起工作。如果您运行上面的脚本，它将记录 Sheet1 中的第一行。一旦添加了 K 列的逻辑，它将忽略第一行并且不记录它，因为位置不在 0>1 之间，它是 20。

标签： arrays excel vba worksheet-function rtd

【解决方案1】：

未经测试：

Private Sub Worksheet_Calculate()

    Dim keyCells As Range, i As Long, diff, cKey As Range, kVal
    
    'exit if togglebutton not on
    If Not Worksheets("BA_Size").ToggleButton1.Value Then Exit Sub
    
    On Error GoTo safeexit
    Application.EnableEvents = False
    
    Set keyCells = Me.Range("I6:I500")
    nextrow = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row + 1
    
    For i = 1 To UBound(myArr)
        Set cKey = keyCells(i, 1)
        kVal = cKey.EntireRow.Columns("K").Value ' << read from K
        If kVal >= 0 And kVal <= 1 Then          ' << check the value
            If cKey.Value <> myArr(i, 1) Then 
                diff = (cKey.Value - myArr(i, 1))
                'check value in Col L
                Select Case cKey.EntireRow.Columns("L").Value
                    Case "John": diff = diff * cKey.EntireRow.Columns("O").Value
                    Case "Mary": diff = diff * cKey.EntireRow.Columns("P").Value
                    Case Else: diff = 0
                End Select
                Sheet1.Cells(nextrow, "A").Value = diff
                nextrow = nextrow + 1
            End If
        End If 'K value is between 0 and 1
    Next i
      
safeexit:
    PopulateMyArr
    Application.EnableEvents = True
End Sub

【讨论】：

谢谢蒂姆。你又做了。感谢您的帮助。