多个数组计算 [英] Multiple Array Calculations

问题描述

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

Script below runs a array difference calculation then processes the data further if other criteria is met. I need to add one additional criteria to filter the data further before it logs the final output to Sheet1. Need to add the "Location" in column "K" so it filters the data first before it logs it to Sheet1.

模块 1 中的代码

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

本工作簿中的代码

Private Sub Workbook_Open()
PopulateMyArr
End Sub

Sheet4 中的代码(BA_Size)

Code in 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

推荐答案

未测试:

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

这篇关于多个数组计算的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！