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

标签 vba excel

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

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

我对这个特定的项目有一个完整的创意障碍,并且我一生都无法找到一种更有效的方法来实现它,如果进一步保证额外的标准,该方法将更容易扩展。

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

它不需要是“IsEmpty”,可以用任何 bool 值或字符串、整数或任何其他情况结果替换。

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 语句,而是创建了一个数组,该数组包含与每个参数的函数名称相对应的名称。然后我在每个循环中调用每个函数。这样,如果我想添加新参数,我只需添加另一个函数即可。

如果我有 6 个参数,则相当于 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),如果所有条件都为,则该变量的值为0;如果所有条件为真,则该变量的值为63。

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

Application.Run "Macro" & N

关于vba - 基于多个可选条件执行代码的有效方法 (Excel VBA),我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/49983922/

相关文章:

vba - 将文本转换为数字

string - VBA 如果单元格中的前 6 个字符不等于 01/01/then

excel - 为什么 INDIRECT() 不适用于名称引用?

excel - 如何将 MS Excel 连接到 Azure Cosmos DB-SQLAPI?

vba - Visual Basic - 编译错误 : Invalid qualifier

vba - VBA excel 中的范围

vba - Excel VBA 优化

vba - Excel中的小数位问题

excel - 查找重复项并将其标记为 "Other Dups"的第一个和其余的 dup 标记

excel - 如何关闭特定工作簿以响应接收具有特定标题的 Outlook 邮件?