我需要根据不同的标准对数据行进行隔离。我正在尝试编写一个函数来捕获所有条件,但不确定如何构造它。我的第一个想法是使用案例陈述吗?那仍然重复了很多代码。
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
?有时候我想要=
,有时候是>
。
答案 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
希望这会有所帮助