处理各种条件的功能(参数)

时间:2019-09-10 18:18:11

标签: excel vba

我需要根据不同的标准对数据行进行隔离。我正在尝试编写一个函数来捕获所有条件,但不确定如何构造它。我的第一个想法是使用案例陈述吗?那仍然重复了很多代码。

Sub stackoverflow()
'first criteria is string
hold = "Yes"
arrTarget = populate(hold)
wsHold.Range("A2").Resize(UBound(arrTarget), UBound(arrTarget, 2)) = arrTarget

'second criteria is date
dueDate = InputBox("Enter cut off date for check run" & vbCrLf & "date entered is inclusive" & vbCrLf & "(any format works?)")
arrTarget = populate(dueDate)
wsNext.Range("A2").Resize(UBound(arrTarget), UBound(arrTarget, 2)) = arrTarget


End Sub

Function populate(arg As Variant) As Variant

Dim wsSource As Worksheet
Dim lastRow As Long
Dim arrSource As Variant
Dim arrReturn As Variant

Set wsSource = ActiveWorkbook.Worksheets("Sheet1")

With wsSource

lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

arrSource = .Range("A2:L" & lastRow) 'store source range into source array

Select Case arg 'some puesdo code to follow
case string
    For i = 1 To UBound(arrSource)
        If arrSource(i, 9) = arg Then
            k = k + 1
        End If
    Next

    ReDim arrReturn(1 To k, 1 To UBound(arrSource, 2))

    k = 0

    For i = 1 To UBound(arrSource)
        If arrSource(i, 9) = arg Then
            k = k + 1
            For j = 1 To UBound(arrSource, 2)
                arrReturn(k, j) = arrSource(i, j)
            Next
        End If
    Next

'if it's date, we want to test if greater than date
Case Date
    For i = 1 To UBound(arrSource)
        If DateValue(arrSource(i, 9)) > DateValue(arg) Then
            k = k + 1
        End If
    Next

so on and so forth...

End With

populate = arrReturn

End Function

基本上,如何根据条件来操作If arrSource(i, 9) = arg Then?有时候我想要=,有时候是>

2 个答案:

答案 0 :(得分:1)

我不确定它会节省很多键入内容,但是如果您想操作测试条件而不必一直重写它,则可以创建一个Compare函数,该函数采用比较作为参数。

您可以在模块顶部定义一个新类型,如下所示:

Enum ComparisonType
  vbEquality = 1
  vbBigger = 2
  vbSmaller = 4
End Enum

然后函数看起来像这样

Function Compare(ByVal lhs As Variant, ByVal rhs As Variant, ComparisonType As ComparisonType) As Boolean

    If ComparisonType = vbEquality Then

        If lhs = rhs Then
            Compare = True
        End If

    ElseIf ComparisonType = vbBigger Then

        If lhs > rhs Then
            Compare = True
        End If

    ElseIf ComparisonType = vbSmaller Then

        If lhs < rhs Then
            Compare = True
        End If

    End If

End Function

并且由于不同的比较具有不同的值(在这种情况下为2的幂),您可以使用一种方法,该方法根据组合成一个数字的不同条件来计算所需的比较类型。

答案 1 :(得分:0)

除非您决定将所有内容都放入变体中,否则您不会真正摆脱案例。但您可以极大地减轻您的生活:)

     dim n1  as long 
     n1=  UBound(arrSource,1) 'dimension 1
     dim n2 as long 
     n2  UBound(arrSource,2) 'dimension '2

     For i = 1 to n1
     For j = 1 to n2

     var data=arrSource(i,j)


     'now you could convert everyting to string or variant 
      VT= VarType(data) 

                Select Case  VT

                    Case vbDouble

                         dim d as double 
                         d=cdbl(data)     'or 
                         dim v as variant 
                         v=data


                    Case vbString  '8

                    Case vbEmpty    '0

                    Case vbNull  '1

                    Case vbInteger    '2

                    Case vbLong    '3

                    Case vbSingle    '4

                    Case vbDouble  '5

                    Case vbCurrency  '6

                    Case vbDate  '7

                    Case vbObject    '9

                    Case vbError    '10

                    Case vbBoolean    '11

                    Case vbVariant    '12

                    Case vbDataObject    '13

                    Case vbDecimal    '14

                    Case vbByte    '15

                    Case Else

                End Select

     now do your calculations with the single data element
     'and convert it back if you want 
     Select Case  VT'w know already what was data before

                    Case vbDouble
                       data=cdbl(v)
                    Case vbString  '8

                    Case vbEmpty    '0

                    Case vbNull  '1

                    Case vbInteger    '2

                    Case vbLong    '3

                    Case vbSingle    '4

                    Case vbDouble  '5

                    Case vbCurrency  '6

                    Case vbDate  '7

                    Case vbObject    '9

                    Case vbError    '10

                    Case vbBoolean    '11

                    Case vbVariant    '12

                    Case vbDataObject    '13

                    Case vbDecimal    '14

                    Case vbByte    '15

                    Case Else

                End Select



     next
     next 

确保两个选择的树都可以开发为功能

          function convertback(data,vt) as variant
               select case(vt)
                    Case vbDouble

                       data=cdbl(v)

                    Case vbString  '8

                    Case vbEmpty    '0

                    Case vbNull  '1

                    Case vbInteger    '2

                    Case vbLong    '3

                    Case vbSingle    '4

                    Case vbDouble  '5

                    Case vbCurrency  '6

                    Case vbDate  '7

                    Case vbObject    '9

                    Case vbError    '10

                    Case vbBoolean    '11

                    Case vbVariant    '12

                    Case vbDataObject    '13

                    Case vbDecimal    '14

                    Case vbByte    '15

                    Case Else

                End Select
            convertback= data
            end function

希望这会有所帮助