Hen*_*rik 4 excel vba 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个单独的标准,每个标准可以独立地为真或假,就像有一个六位二进制数:
000000
000001
000010
000011
000100
000101
000110
000111
001000
...
etc.
编造一些代码来计算一个整数变量(N) ,其将具有值0,如果所有的标准是假至63,如果所有的标准是真实的.
与每个值相关联的是宏(如Macro0,Macro1等).然后您需要的就是:
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
| 归档时间： |
|
| 查看次数： |
259 次 |
| 最近记录： |