基于多个可选条件 (Excel VBA) 执行代码的有效方法



有没有比我在下面写的更有效的方法来处理基于多个条件的代码执行?对于三个标准,您可能有九个备选结果,并且随着每个新标准的添加,它将呈指数级扩展。

我的代码有六个单独的标准,您可以使用其中一个或所有标准来实现所需的结果。使用以下方法来检查选择了哪些条件,强制创建 36 个单独的代码块,并使添加新代码块变得很痛苦。

我对这个特定的项目有一个完整的创意块,并且我一生都无法找到一种更有效的方法,如果以后需要额外的标准,这种方法将更容易扩展。

我将不胜感激任何人能提供的任何帮助。我可以发布实际代码,但我对通用解决方案更感兴趣,以便将来能够在其他项目中实现它,而不是解决一个特定问题。

它不需要是"IsEmpty",可以用任何布尔值替换,或者就此而言,字符串、整数或任何其他情况结果。

Select Case IsEmpty(x) & IsEmpty(y) & IsEmpty(z)
Case Is = True & True & True
'do stuff
Case Is = False & True & True
'do stuff
Case Is = True & False & True
'do stuff
Case Is = True & True & False
'do stuff
Case is = False & False & True
'do stuff
End Select

提前感谢!

编辑:

自从写了上面的问题以来,我一直在尝试解决我遇到的指数级增加的if语句的问题。我想出了以下方法,效果很好,并认为如果其他人遇到类似的问题,我会分享。

我没有为每个潜在结果提供一个 if 语句,而是创建了一个数组,该数组输入与每个参数的函数名称相对应的名称。然后,我每个循环调用这些函数中的每一个。这样,如果我想添加新参数,我可以添加另一个函数。

如果我有六个参数,相当于 36 个 if 语句来解释每个潜在的搜索结果。使用这种方法,我只需要六个简短的函数。

我敢肯定,我可以对代码进行数百万项改进以使其运行得更快,但它可以很好地避免处理多个参数时的组合爆炸。

Public Sub SearchStuff()
Dim book As Workbook
Dim shResult As Worksheet
Dim shSource As Worksheet
Set book = ThisWorkbook
Set shResult = book.Worksheets("Sheet1")
Set shSource = book.Worksheets("Sheet2")
shResult.EnableCalculation = False
'Parameters avaiable to search with
Dim param1 As Range
Dim param2 As Range
Dim param3 As Range
Set param1 = shResult.Range("A1")
Set param2 = shResult.Range("A2")
Set param3 = shResult.Range("A3")       
'Boolean expressions of whether or not the above parameters are being used
Dim isUsedParam1 As Boolean
Dim isUsedParam2 As Boolean
Dim isUsedParam3 As Boolean
isUsedParam1 = Not IsEmpty(param1)
isUsedParam2 = Not IsEmpty(param2)
isUsedParam3 = Not IsEmpty(param3)
Dim lastSearchRow As Long
lastSearchRow = shSource.Cells(Rows.Count, "A").End(xlUp).Row
Dim rngSearch As Range
Set rngSearch = shSource.Range("A2:A" & lastSearchRow)
Dim lastRow As Long
Dim rngOutput As Range
Dim rngToCopy As Range
Dim noSearchCriteriaProvided As Boolean
Dim firstSectionToCopy As Range
Dim secondSectionToCopy As Range
Dim thirdSectionToCopy As Range
Dim loopingCell As Range
For Each loopingCell In rngSearch
If noSearchCriteriaProvided = True Then
MsgBox "No search criteria provided." & vbNewLine & vbNewLine & "Please select at least one criteria to search for and try again.", , "Whoopsie!"
Exit Sub
End If
lastRow = shResult.Cells(Rows.Count, "B").End(xlUp).Row
Set rngOutput = shResult.Range("B" & lastRow + 1)
If CheckParams(isUsedDU, isUsedELR, isUsedNUM, isUsedFault, isUsedMil, loopingCell, shResult, noSearchCriteriaProvided) = True Then
Set firstSectionToCopy = shSource.Range("A" & loopingCell.Row, "C" & loopingCell.Row)
Set secondSectionToCopy = shSource.Range("E" & loopingCell.Row, "I" & loopingCell.Row)
Set thirdSectionToCopy = shSource.Range("K" & loopingCell.Row, "M" & loopingCell.Row)
Set rngToCopy = Union(firstSectionToCopy, secondSectionToCopy, thirdSectionToCopy)
rngToCopy.Copy Destination:=rngOutput
End If
Next
shResult.EnableCalculation = True
End Sub
Public Function CheckParams(isUsedParam1 As Boolean, isUsedParam2 As Boolean, isUsedParam3 As Boolean, loopingCell As Range, shResult As Worksheet, noSearchCriteriaProvided As Boolean) As Boolean
Dim arraySize As Long
arraySize = 0
Dim myArray() As String
Dim funcTitle As String
Dim modTitle As String
ReDim myArray(0)
If isUsedParam1 = True Then
arraySize = arraySize + 1
ReDim Preserve myArray(arraySize - 1)
myArray(arraySize - 1) = "CheckForParam1Match"
End If
If isUsedParam2 = True Then
arraySize = arraySize + 1
ReDim Preserve myArray(arraySize - 1)
myArray(arraySize - 1) = "CheckForParam2Match"
End If
If isUsedParam3 = True Then
arraySize = arraySize + 1
ReDim Preserve myArray(arraySize - 1)
myArray(arraySize - 1) = "CheckForParam3Match"
End If

'CHECKS IF ARRAY IS "EMPTY"
If myArray(0) = vbNullString Then
noSearchCriteriaProvided = True
Exit Function
End If
For i = LBound(myArray) To UBound(myArray)
funcTitle = myArray(i)
modTitle = "Search."
If Application.Run(modTitle & funcTitle, loopingCell, shResult) = False Then
Exit Function
End If
Next
CheckParams = True
End Function
Function CheckForParam1Match(loopingCell As Range, shResult As Worksheet) As Boolean
Dim param1 As Range
Set param1 = shResult.Range("A1")
If loopingCell.Offset(0, 4).Value = param1.Value Then
CheckForDUMatch = True
End If
End Function
Function CheckForParam2Match(loopingCell As Range, shResult As Worksheet) As Boolean
Dim param2 As Range
Set param2 = shResult.Range("A2")
If loopingCell.Offset(0, 5).Value = param2.Value Then
CheckForELRMatch = True
End If
End Function
Function CheckForParam3Match(loopingCell As Range, shResult As Worksheet) As Boolean
Dim param3 As Range
Set param3 = shResult.Range("A3")
If loopingCell.Offset(0, 6).Value = param3.Value Then
CheckForNUMMatch = True
End If
End Function

有 6 个单独的标准,每个标准都可以独立地为truefalse,就像有一个六位二进制数:

000000
000001
000010
000011
000100
000101
000110
000111
001000
...
etc.

编写一些代码来计算一个整数变量(N),如果所有条件都为 false,则该变量的值为 0,如果所有条件都为真,则值为 63。

与每个值相关联的是一个宏(如Macro0Macro1等)。 那么你所需要的只是这样的东西:

Application.Run "Macro" & N

有趣的是,@GarysStudent也有同样的想法。我有一个为这种情况创建的库例程:

Option Explicit
Sub test()
Dim boolA As Boolean
Dim boolB As Boolean
Dim boolC As Boolean
boolA = True
boolB = False
boolC = False
Dim combined As Long
combined = BooleanToBits(boolA, boolB, boolC)
Debug.Print "combined flags = " & combined
Debug.Print "should be  5 = "; BooleanToBits(True, False, True)
Debug.Print "should be  7 = "; BooleanToBits(True, True, True)
Debug.Print "should be  3 = "; BooleanToBits(False, True, True)
Debug.Print "should be 22 = "; BooleanToBits(True, False, True, True, False)
End Sub
Function BooleanToBits(ParamArray flag()) As Long
'--- based on the number of boolean flags passed as parameters, this
'    function determines how many bits to use and converts each value
'    left-to-right: flag1=highest bit...flagN=lowest bit (1's place)
Dim numBits As Long
Dim setBit As Long
numBits = UBound(flag)
Dim i As Long
Dim result As Long
For i = LBound(flag) To UBound(flag)
setBit = 2 ^ numBits
If flag(i) = True Then
result = result + setBit
Else
'--- it's already zero, so leave it
End If
numBits = numBits - 1
Next i
BooleanToBits = result
End Function

您似乎对Select Case语句有问题。

表达式IsEmpty(x) & IsEmpty(y) & IsEmpty(z)IsEmpty的三个结果的串联。例如,它将导致TrueTrueTrue。你是说逻辑AND吗?

同样,大小写标签在你写它们时,例如Case Is = True, True, True表示"如果表达式Is =True,或者TrueTrue,则执行以下"做事"。硬明白你的意思。

由于您的意思尚不清楚,因此我无法为您提供解决方案,除了建议查找 selectcase 语句。

最新更新