Excel VBA - Select multiple values to search a Cas

问题:

I wrote a program that totals the number of times X number of widgets are tested in a day based upon a start and end count. After a period of time a widget will fail and have to be replaced, thus the count will start back at zero. I am using a Select Case to compute the data and a drop-down menu in Excel to select the widget(s). Everything works great besides one thing... I can't select multiple widgets to search the Case.

I understand the general principles of the Case Statement - but is there any way around searching for only one scenario via a Case?

'Create subroutine that will copy and total data from worksheet 1 to worksheet 2
Private Sub VTS()

'Establish variable for CASE to search
Dim ValR As String

'Establish counter array
Dim myarray(1 To 170)

myarray(1) = Worksheets(2).Range("A7").Value
myarray(2) = Worksheets(2).Range("A10").Value
...  

ValR = Worksheets(1).Range("B4").Value

Select Case ValR
  Case "1A"
    Worksheets(2).Range("C7").Copy ' Copy current Total
    Worksheets(2).Range("A7").PasteSpecial ' Move to "Previous Total" to sum total
    myarray(1) = Worksheets(1).Range("B3").Value - Worksheets(1).Range("B2").Value
    If myarray(1) < 0 Then
        myarray(1) = 1000000 + myarray(1)
    End If
    Worksheets(2).Range("B7").Value = myarray(1)
    Worksheets(2).Range("C7").Value = Worksheets(2).Range("A7").Value + Worksheets(2).Range("B7").Value
    Worksheets(2).Range("C7").Copy
    Worksheets(1).Range("B10").PasteSpecial
  Case "1B"
    Worksheets(2).Range("C10").Copy
    Worksheets(2).Range("A10").PasteSpecial
    myarray(2) = Worksheets(1).Range("B3").Value - Worksheets(1).Range("B2").Value
    If myarray(2) < 0 Then
        myarray(2) = 1000000 + myarray(2)
    End If
    Worksheets(2).Range("B10").Value = myarray(2)
    Worksheets(2).Range("C10").Value = Worksheets(2).Range("A10").Value + Worksheets(2).Range("B10").Value
    Worksheets(2).Range("C10").Copy
    Worksheets(1).Range("B10").PasteSpecial
  Case Else
    MsgBox "Wrong Model Entered / Model Does Not Exist"
End Select

End Sub

Any suggestions?

THANKS!

回答1:

You can have the user separate widgets by ";" and then use the following loop:

'widgetString = "widget1;widget2;widget3"

widgets = Split(widgetString, ";")

for w = 0 to ubound(widgets)
    thisWidget = widgets(w)

    'place all of your code here, with thisWidget being the current widget being evaluated

next w