Question

我正在尝试删除向量中的行，具体取决于将返回向量的VBA函数中另一个向量的值。感谢。

例如：

条件= [1; 0; 1; 1; 0]（5x1）

数据= [0.6; 0.7; 0.75; 0.81; 0.94]（5x1）

预期结果= [0.6; 0.75; 0.81]（3x1）

Function RANGEIF(data As Range, condition As Range) As Range
'
' Inputs
'
' data:         Vector Nx1 of data
' condition:    Vector Nx1 of binairy conditions
'
' Outputs
'
' RANGEIF:      Vector Nx1 of specific data

' Variable declaration
Dim nRowData As Integer
Dim nRowCond As Integer

' Input vector size
nRowData = data.Rows.Count
nRowCond = condition.Rows.Count

' Input validation
If nRowData <> nRowCond Then
    msg = "Error: Input vector sizes do not match"
    MsgBox msg, , "Error", Err.HelpFile, Err.HelpContext
    GoTo endnow
End If

' Conditional range
For j = nRowCond To 1 Step -1
    If condition(j, 1).Value <> 1 Then
        data.Cells(j, 1).Delete
    End If
Next j

Set RANGEIF = data

endnow:

End Function

Answer 1

只要并非所有值都被滤除，这将有效...

Function RANGEIF(data As Range, condition As Range)
    Dim n As Long, rv() As Variant, i As Long, msg, j As Long

    ' Input validation
    If data.Rows.Count <> condition.Rows.Count Then
        msg = "Error: Input vector sizes do not match"
        MsgBox msg, , "Error", Err.HelpFile, Err.HelpContext
        Exit Function
    End If

    n = Application.CountIf(condition, 1)
    If n > 1 Then
        ReDim rv(1 To n, 1 To 1)
        i = 1
        For j = 1 To data.Rows.Count
            If condition(j, 1).Value = 1 Then
                rv(i, 1) = data(j, 1)
                i = i + 1
            End If
        Next j
        RANGEIF = rv
    Else
        'what to do if no values are available?
        RANGEIF = "No values"
    End If

End Function

删除矢量VBA Excel中的行

1 个答案: