如何合并If Or then语句，行数过多

Question

这就是我到目前为止所拥有的，它达到了行太多的地步，所以我做了另一个IF，但没有结果。有没有办法在vba中整合所有这些，或者我做错了。

Dim Run_Medallions() As Long                                                                    'Medallions used in each run
ReDim Run_Medallions(RunCnt)                                                                    'Medallions used in each run
For i = 1 To RunCnt
If Left(Ip.Cells(3, i + 2), 7) = "VMCCHAR" Or _
Left(Ip.Cells(3, i + 2), 7) = "VMCBDXB" Or _
Left(Ip.Cells(3, i + 2), 7) = "VMEBDOR" Or _
Left(Ip.Cells(3, i + 2), 7) = "VMEPIOR" Or _
Left(Ip.Cells(3, i + 2), 7) = "VMEROOR" Or _
Left(Ip.Cells(3, i + 2), 7) = "VMESAOR" Or _
Left(Ip.Cells(3, i + 2), 7) = "VMPBDXB" Or _
Left(Ip.Cells(3, i + 2), 7) = "VMPCHAR" Or _
Left(Ip.Cells(3, i + 2), 7) = "VMPGEWZ" Or _
Left(Ip.Cells(3, i + 2), 7) = "VMPMERL" Or _
Left(Ip.Cells(3, i + 2), 7) = "VMPMEOR" Or _
Left(Ip.Cells(3, i + 2), 7) = "VMPSAOR" Or _
Left(Ip.Cells(3, i + 2), 7) = "VMPPGRI" Or _
Left(Ip.Cells(3, i + 2), 7) = "VMPPINO" Or _
Left(Ip.Cells(3, i + 2), 7) = "VMPRIES" Or _
Left(Ip.Cells(3, i + 2), 7) = "VMPROSE" Or _
Left(Ip.Cells(3, i + 2), 7) = "VMPSAUV" Or _
Left(Ip.Cells(3, i + 2), 7) = "VMCSAUV" Or _
Left(Ip.Cells(3, i + 2), 3) = "RSX" Then

'# Product use medallions
Run_Medallions(i) = Ip.Cells(38, i + 2) + Ip.Cells(63, i + 2) + 50

Else

'# No medallions
Run_Medallions(i) = 0

End If ' Medallions

'# Medallions label  Part 2                                                             'Medallions used in each run
'# Medallion label =
'# Labeller count + specific wastes + 50 start-up wastes

'# If product is Single Vineyard Range, Te Awa Range, Tesco, Vidal Range

If Left(Ip.Cells(3, i + 2), 7) = "VMPSALA" Or _
Left(Ip.Cells(3, i + 2), 7) = "VMSALBA" Or _
Left(Ip.Cells(3, i + 2), 7) = "VMSCHAR" Or _
Left(Ip.Cells(3, i + 2), 7) = "VMSROOR" Or _
Left(Ip.Cells(3, i + 2), 7) = "VMSPINO" Or _
Left(Ip.Cells(3, i + 2), 7) = "VMSPGRI" Or _
Left(Ip.Cells(3, i + 2), 7) = "VMSSAUV" Or _
Left(Ip.Cells(3, i + 2), 7) = "VMSPIOR" Or _
Left(Ip.Cells(3, i + 2), 7) = "TAEBDXB" Or _
Left(Ip.Cells(3, i + 2), 7) = "TAESYRH" Or _
Left(Ip.Cells(3, i + 2), 3) = "PTE" Or _
Left(Ip.Cells(3, i + 2), 3) = "THV" Or _
Left(Ip.Cells(3, i + 2), 3) = "VDL" Or _
Left(Ip.Cells(3, i + 2), 3) = "VDJ" Or _
Left(Ip.Cells(3, i + 2), 3) = "VMI" Then

'# Product use medallions
Run_Medallions(i) = Ip.Cells(38, i + 2) + Ip.Cells(63, i + 2) + 50

Else

'# No medallions
Run_Medallions(i) = 0

End If ' Medallions2

End If '# Front and Back and Medallions Label
                          '# Display Pallet Ticket Usage
.Cells(32, i + 1) = Run_Medallions(i)

Ip.cells是输入工作表，.cells是显示它的另一个工作表。基本上任何看起来具有"；字符"；它显示它有奖章，如果没有，则显示0。

当然，这是一个简单的修复

Answer 1

除了使用Select...Case，您还可以合并一个For...Next循环，并将所有要检查的值分配到数组中。

类似于；

Dim ArrayElement As Long
Dim MyArray As Variant
MyArray = Array("VMCCHAR", "VMCBDXB", "VMEBDOR", "VMEPIOR", "VMESAOR", "VMPBDXB", "VMPCHAR", "RSX")  'Add all items to the array here
For i = 1 To RunCnt
For ArrayElement = LBound(MyArray) To UBound(MyArray)
If Left(Ip.Cells(3, i + 2), Len(MyArray(ArrayElement))) = MyArray(ArrayElement) Then
'# Product use medallions
Run_Medallions(i) = Ip.Cells(38, i + 2) + Ip.Cells(63, i + 2) + 50
Else
'# No medallions
Run_Medallions(i) = 0
End If ' Medallions
Next ArrayElement
Next i

注意：我没有将您的所有值添加到数组中，所以如果您使用此方法，请确保添加要检查的缺失值。