多数组计算

Question

下面的脚本运行数组差异计算，然后在满足其他条件时进一步处理数据。在将最终输出记录到 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

Answer 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

多数组计算

Multiple Array Calculations

arrays

excel

vba

worksheet-function

rtd