Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
638 views
in Technique[技术] by (71.8m points)

vba - Excel Select Case?

i want to create the "cases" formula for excel to simulate Select case behavior (with multiple arguments and else optional). If A1 and A2 are excel cells, this is the goal:

A1 Case:     A2 Formula:                                                                   A2 Result
5            cases({A1>5,"greather than 5"}, {A1<5, "less than 5"},{else,"equal to 5"})    equal to 5   
Hi           cases({A1="","there is nothing"},{else,A1})                                   Hi
1024         cases({5<A1<=10,10},{11<=A1<100,100},{A1>100,1000})                           1000
12           cases({A1=1 to 9, "digit"}, {A1=11|22|33|44|55|66|77|88|99, "11 multiple"})   (empty) 
60           cases({A1=1 to 49|51 to 99,"not 50"})                                         not 50

If it could, It must accept excel formulas or vba code, to make an operation over the cell before take a case, i.g.

cases({len(A1)<7, "too short"},{else,"good length"})

If it could, it must accept to or more cells to evaluate, i.g.

if A2=A3=A4=A5=1 and A1=2, A6="one", A7="two"

cases(A1!=A2|A3|A4|A5, A6}, {else,A7}) will produce "two"

By the way, | means or, != means different

Any help?


I'm grateful.

What I could write was this:

Public Function arr(ParamArray args())  'Your function, thanks
    arr = args
End Function

Public Function cases(arg, arg2)  'I don't know how to do it better
    With Application.WorksheetFunction
        cases = .Choose(.Match(True, arg, 0), arg2)
    End With
End Function

I call the function in this way

=cases(arr(A1>5, A1<5, A1=5),arr( "gt 5", "lt 5", "eq 5"))

And i can't get the goal, it just works for the first condition, A1>5.

I fixed it using a for, but i think it's not elegant like your suggestion:

Function selectCases(cases, actions)
    For i = 1 To UBound(cases)
        If cases(i) = True Then
            selectCases = actions(i)
            Exit Function
        End If
    Next
End Function

When i call the function:

=selectCases(arr(A1>5, A1<5, A1=5),arr( "gt 5", "lt 5", "eq 5"))

It works.

Thanks for all.


After work a little, finally i get a excel select case, closer what i want at first.

Function cases(ParamArray casesList())
    'Check all arguments in list by pairs (case, action),
    'case is 2n element
    'action is 2n+1 element
    'if 2n element is not a test or case, then it's like the "otherwise action"
    For i = 0 To UBound(casesList) Step 2
        'if case checks
        If casesList(i) = True Then
            'then take action
            cases = casesList(i + 1)
            Exit Function
        ElseIf casesList(i) <> False Then
            'when the element is not a case (a boolean value),
            'then take the element.
            'It works like else sentence
            cases = casesList(i)
            Exit Function
        End If
    Next
End Function

When A1=5 and I call:

=cases(A1>5, "gt 5",A1<5, "lt 5","eq 5")

It can be read in this way: When A1 greater than 5, then choose "gt 5", but when A1 less than 5, then choose "lt 5", otherwise choose "eq 5". After run it, It matches with "eq 5"

Thank you, it was exciting and truly educative!

See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Reply

0 votes
by (71.8m points)

O.K., there's no way at all to do exactly what you want. You can't use anything other than Excel syntax within a formula, so stuff like 'A1 = 1 to 9' is just impossible.

You could write a pretty elaborate VBA routine that took strings or something and parsed them, but that really amounts to designing and implementing a complete little language. And your "code" wouldn't play well with Excel. For example, if you called something like

=cases("{A1="""",""there is nothing""},{else,A1}")

(note the escaped quotes), Excel wouldn't update your A1 reference when it moved or the formula got copied. So let's discard the whole "syntax" option.

However, it turns out you can get much of the behavior I think you actually want with regular Excel formulas plus one tiny VBA UDF. First the UDF:

Public Function arr(ParamArray args())
    arr = args
End Function

This lets us create an array from a set of arguments. Since the arguments can be expressions instead of just constants, we can call it from a formula like this:

=arr(A1=42, A1=99)

and get back an array of boolean values.

With that small UDF, you can now use regular formulas to "select cases". They would look like this:

=CHOOSE(MATCH(TRUE, arr(A1>5, A1<5, A1=5), 0), "gt 5", "lt 5", "eq 5")

What's going on is that 'arr' returns a boolean array, 'MATCH' finds the position of the first TRUE, and 'CHOOSE' returns the corresponding "case".

You can emulate an "else" clause by wrapping the whole thing in 'IFERROR':

=IFERROR(CHOOSE(MATCH(TRUE, arr(A1>5, A1<5), 0), "gt 5", "lt 5"), "eq 5")

If that is too verbose for you, you can always write another VBA UDF that would bring the MATCH, CHOOSE, etc. inside, and call it like this:

=cases(arr(A1>5, A1<5, A1=5), "gt 5", "lt 5", "eq 5")

That's not far off from your proposed syntax, and much, much simpler.

EDIT:

I see you've already come up with a (good) solution that is closer to what you really want, but I thought I'd add this anyway, since my statement above about bringing MATCH, CHOOSE, etc. inside the UDF made it look easier thatn it really is.

So, here is a 'cases' UDF:

Public Function cases(caseCondResults, ParamArray caseValues())
    On Error GoTo EH

    Dim resOfMatch
    resOfMatch = Application.Match(True, caseCondResults, 0)

    If IsError(resOfMatch) Then
        cases = resOfMatch
    Else
        Call assign(cases, caseValues(LBound(caseValues) + resOfMatch - 1))
    End If

    Exit Function

EH:
    cases = CVErr(xlValue)
End Function

It uses a little helper routine, 'assign':

Public Sub assign(ByRef lhs, rhs)
    If IsObject(rhs) Then
        Set lhs = rhs
    Else
        lhs = rhs
    End If
End Sub

The 'assign' routine just makes it easier to deal with the fact that users can call UDFs with either values or range references. Since we want our 'cases' UDF to work like Excel's 'CHOOSE', we'd like to return back references when necessary.

Basically, within the new 'cases' UDF, we do the "choose" part ourselves by indexing into the param array of case values. I slapped an error handler on there so basic stuff like a mismatch between case condition results and case values will result in a return value of #VALUE!. You would probably add more checks in a real function, like making sure the condition results were booleans, etc.

I'm glad you reached an even better solution for yourself, though! This has been interesting.

MORE ABOUT 'assign':

In response to your comment, here is more about why that is part of my answer. VBA uses a different syntax for assigning an object to a variable than it does for assigning a plain value. Look at the VBA help or see this stackoverflow question and others like it: What does the keyword Set actually do in VBA?

This matters because, when you call a VBA function from an Excel formula, the parameters can be objects of type Range, in addition to numbers, strings, booleans, errors, and arrays. (See Can an Excel VBA UDF called from the worksheet ever be passed an instance of any Excel VBA object model class other than 'Range'?)

Range references are what you describe using Excel syntax like A1:Q42. When you pass one to an Excel UDF as a parameter, it shows up as a Range object. If you want to return a Range object from the UDF, you have to do it explicitly with the VBA 'Set' keyword. If you don't use 'Set', Excel will instead take the value contained within the Range and return that. Most of the time this doesn't matter, but sometimes you want the actual range, like when you've got a named formula that must evaluate to a range because it's used as the source for a validation list.


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
OGeek|极客中国-欢迎来到极客的世界,一个免费开放的程序员编程交流平台!开放,进步,分享!让技术改变生活,让极客改变未来! Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...