嵌套select案例的多个条件

情况:我有一个代码,通过工作表中的一些数据,并给予什么是在某个单元格粘贴到另一列(同一行)的东西。

例如:如果我的A5是“债券”,它连接A5和B5的内容并将其粘贴到J5。

Obs1:对于第一,第二,第三和第四列数据,有几十个子条件。

我到目前为止的尝试:我能够创build一个非常长的嵌套如果链和帐户的所有条件。 我也能够使用select案例来说明第一列的条件。

问题:现在我试图使用嵌套Select Case来解决这个问题(考虑到If链是庞大的,而且效率太高)。 问题是我无法正确说明多个条件的嵌套Select Case。

问题:在存在多个条件时,使用嵌套Select Case的最佳方法是什么?

Obs2:从以前的研究中,我发现这里的post是关于嵌套的,特别是当存在真值或假值时。 这对我不起作用,因为每一层都有更多的条件。

代码1:这是我迄今为止使用Select Case:

Function fxr2() Dim lRow As Long, LastRow As Long Dim w As Workbook Dim ws As Worksheet Set w = ThisWorkbook Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual LastRow = Worksheets("Fixer").Cells(Rows.Count, "A").End(xlUp).Row For lRow = 7 To LastRow Dim type1 As String, result As String type1 = w.Worksheets("Fixer").Cells(lRow, 1).Text Select Case type1 Case Is = "Bail-in" result = w.Worksheets("Fixer").Cells(lRow, 1) Case Is = "Basel" result = w.Worksheets("Fixer").Cells(lRow, 1) & " " & w.Worksheets("Fixer").Cells(lRow, 2) & " " & w.Worksheets("Fixer").Cells(lRow, 3) & " " & w.Worksheets("Fixer").Cells(lRow, 4) & " " & w.Worksheets("Fixer").Cells(lRow, 5) Case Is = "Collateral" result = w.Worksheets("Fixer").Cells(lRow, 1) & " " & w.Worksheets("Fixer").Cells(lRow, 2) & " " & w.Worksheets("Fixer").Cells(lRow, 3) Case Is = "Design" result = w.Worksheets("Fixer").Cells(lRow, 1) Case Is = "General" result = w.Worksheets("Fixer").Cells(lRow, 1) & " " & w.Worksheets("Fixer").Cells(lRow, 2) & " " & w.Worksheets("Fixer").Cells(lRow, 3) Case Is = "Investment" result = w.Worksheets("Fixer").Cells(lRow, 1) Case Is = "Lower" result = w.Worksheets("Fixer").Cells(lRow, 1) & " " & w.Worksheets("Fixer").Cells(lRow, 2) & " " & w.Worksheets("Fixer").Cells(lRow, 3) Case Is = "Recapitalization" result = w.Worksheets("Fixer").Cells(lRow, 1) Case Is = "Refinance" result = w.Worksheets("Fixer").Cells(lRow, 1) Case Is = "Upper" result = w.Worksheets("Fixer").Cells(lRow, 1) & " " & w.Worksheets("Fixer").Cells(lRow, 2) & " " & w.Worksheets("Fixer").Cells(lRow, 3) Case Else result = w.Worksheets("Fixer").Cells(lRow, 1) & " " & w.Worksheets("Fixer").Cells(lRow, 2) End Select w.Worksheets("Fixer").Cells(lRow, 10).Value = result Next lRow End Function 

代码2:这是我使用嵌套的Ifs的代码的一小部分:

 ElseIf w.Worksheets("Fixer").Cells(lRow, 1) = "General" Then w.Worksheets("Fixer").Cells(lRow, 10) = w.Worksheets("Fixer").Cells(lRow, 1) & " " & w.Worksheets("Fixer").Cells(lRow, 2) & " " & w.Worksheets("Fixer").Cells(lRow, 3) If w.Worksheets("Fixer").Cells(lRow, 4) = "Base" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Inte" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Tier" Or w.Worksheets("Fixer").Cells(lRow, 4) = "v" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Ba" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Bas" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Int" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Inte" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Inter" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Tie" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Tier-" Then w.Worksheets("Fixer").Cells(lRow, 11) = "" ElseIf w.Worksheets("Fixer").Cells(lRow, 4) = "" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Upp" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Uppe" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Upper" Or w.Worksheets("Fixer").Cells(lRow, 4) = "I" Or w.Worksheets("Fixer").Cells(lRow, 4) = "L" Or w.Worksheets("Fixer").Cells(lRow, 4) = "T" Or w.Worksheets("Fixer").Cells(lRow, 4) = "U" Then w.Worksheets("Fixer").Cells(lRow, 11) = "" ElseIf w.Worksheets("Fixer").Cells(lRow, 4) = "Design" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Inve" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Inv" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Low" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Lowe" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Proj" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Pro" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Ref" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Refi" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Stock" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Inve" Then w.Worksheets("Fixer").Cells(lRow, 11) = w.Worksheets("Fixer").Cells(lRow, 4) ElseIf w.Worksheets("Fixer").Cells(lRow, 4) = "LBO" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Working" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Work" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Wor" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Gre" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Gree" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Green" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Interc" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Intercom" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Intercompany" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Intermed" Then w.Worksheets("Fixer").Cells(lRow, 11) = w.Worksheets("Fixer").Cells(lRow, 4) ElseIf w.Worksheets("Fixer").Cells(lRow, 4) = "Low" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Lower" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Lowe" Or w.Worksheets("Fixer").Cells(lRow, 4) = "No" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Pen" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Pens" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Pension" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Projec" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Project" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Refin" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Refina" Then w.Worksheets("Fixer").Cells(lRow, 11) = w.Worksheets("Fixer").Cells(lRow, 4) ElseIf w.Worksheets("Fixer").Cells(lRow, 4) = "Refinanc" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Refinance" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Stoc" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Sto" Or w.Worksheets("Fixer").Cells(lRow, 4) = "w" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Wor" Or w.Worksheets("Fixer").Cells(lRow, 4) = "W" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Tier-1" Or w.Worksheets("Fixer").Cells(lRow, 4) = "Tier-2" Then w.Worksheets("Fixer").Cells(lRow, 11) = w.Worksheets("Fixer").Cells(lRow, 4) End If 

Obs3:为了更好地解释我的数据是如何组织的,这里只是其中的一小部分。 数据示例

您post的第1部分( 代码1 )可能看起来像下面的简短版本(代码注释中的解释):

 Function fxr2() Dim lRow As Long, LastRow As Long Dim w As Workbook Dim ws As Worksheet Set w = ThisWorkbook Set ws = w.Worksheets("Fixer") '<-- set the worksheet Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual Dim type1 As String, result As String '<-- There's no need to Dim them every time inside the loop ' use With statement, will simplify and shorten your code later With ws LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row '<-- fully qualify Rows.Count with "Fixer" sheet For lRow = 7 To LastRow type1 = .Cells(lRow, 1).Text Select Case type1 Case "Bail-in", "Investment", "Recapitalization", "Refinance", "Design" result = .Cells(lRow, 1) Case "Basel" result = .Cells(lRow, 1) & " " & .Cells(lRow, 2) & " " & .Cells(lRow, 3) & " " & .Cells(lRow, 4) & " " & .Cells(lRow, 5) Case "Collateral", "General", "Lower", "Upper" result = .Cells(lRow, 1) & " " & .Cells(lRow, 2) & " " & .Cells(lRow, 3) Case Else result = .Cells(lRow, 1) & " " & .Cells(lRow, 2) End Select .Cells(lRow, 10).Value = result Next lRow End With End Function 

你在代码2中的所有内容都是2个Case条件,由多个String你试图去纠缠:

 Select Case .Cells(lRow, 4) Case "Base", "Inte", "Tier", "v", "Ba", "Bas", "Int", "Inte", "Inter", "Tie", "Tier-", "", "Upp", "Uppe", "Upper", "I", "L", "T" .Cells(lRow, 11) = "" Case "Design", "Inve", "Inv", "Low", "Lowe", "Proj", "Pro", "Ref", "Refi", "Refin", "Refina", "Refinanc", "Refinance", "Stock", "Inve", "LBO", "Working", "Work", "Wor", "Gre", _ "Gree", "Green", "Interc", "Intercom", "Intercompany", "Intermed", "Refinanc", "Stoc", "No", "Pen", "Pens", "Pension", "Projec", "Project", _ "Sto", "Stoc", "w", "Wor", "Tier-1", "Tier-2" .Cells(lRow, 11) = .Cells(lRow, 4) End Select 

不确定这是否正是你想要的地方,但这只是一个如何使用嵌套在另一个Select Case中的Select Case

编辑“合并”的代码

 Function fxr2() Dim lRow As Long, LastRow As Long Dim w As Workbook Dim ws As Worksheet Set w = ThisWorkbook Set ws = w.Worksheets("Fixer") '<-- set the worksheet Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual Dim type1 As String, result As String '<-- There's no need to Dim them every time inside the loop ' use With statement, will simplify and shorten your code later With ws LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row '<-- fully qualify Rows.Count with "Fixer" sheet For lRow = 7 To LastRow type1 = .Cells(lRow, 1).Text Select Case type1 Case "Bail-in", "Investment", "Recapitalization", "Refinance", "Design" .Cells(lRow, 10).Value = .Cells(lRow, 1) Case "Basel" .Cells(lRow, 10).Value = .Cells(lRow, 1) & " " & .Cells(lRow, 2) & " " & .Cells(lRow, 3) & " " & .Cells(lRow, 4) & " " & .Cells(lRow, 5) Case "Collateral", "General", "Lower", "Upper" .Cells(lRow, 10).Value = .Cells(lRow, 1) & " " & .Cells(lRow, 2) & " " & .Cells(lRow, 3) ' ===== Added the Nested case here (just for example) ===== Select Case .Cells(lRow, 4) Case "Base", "Inte", "Tier", "v", "Ba", "Bas", "Int", "Inte", "Inter", "Tie", "Tier-", "", "Upp", "Uppe", "Upper", "I", "L", "T" .Cells(lRow, 11) = "" Case "Design", "Inve", "Inv", "Low", "Lowe", "Proj", "Pro", "Ref", "Refi", "Refin", "Refina", "Refinanc", "Refinance", "Stock", "Inve", "LBO", "Working", "Work", "Wor", "Gre", _ "Gree", "Green", "Interc", "Intercom", "Intercompany", "Intermed", "Refinanc", "Stoc", "No", "Pen", "Pens", "Pension", "Projec", "Project", _ "Sto", "Stoc", "w", "Wor", "Tier-1", "Tier-2" .Cells(lRow, 11) = .Cells(lRow, 4) End Select ' ==== End of Nested Select Case ==== Case Else .Cells(lRow, 10).Value = .Cells(lRow, 1) & " " & .Cells(lRow, 2) End Select Next lRow End With End Function 

大小写可以用相同的方式嵌套,IF可以:

 Select Case a Case 10 Select Case b Case 1 'a is 10, b is 1 Case 2 'a is 10, b is 2 Case 3 'a is 10, b is 3 End Select Case 20 Select Case b Case 1 'a is 20, b is 1 Case 2 'a is 20, b is 2 Case 3 'a is 20, b is 3 End Select End Select 

这可能不是你所期望的答案,但是如果你把它应用到你自己的案例中,逻辑是完美无缺的。

我们假设,VBA定期由微软更新。 至less和C#一样多。 然后,我们会有一些东西,叫[FLAGS],这个问题真的很容易。 但是,我们没有,所以我们应该build立这样的东西。

想象一下,你有7个产品(AAA,BBB,CCC,DDD,EEE,FFF,GGG),你想知道你select了哪一个。 我认为这是你的问题的核心。 这很容易,如果你使用二进制math – 那么第一个产品的值是1,第二个是2,第三个是4,第四个是8等等。

  • 27意味着你已经select了1 + 2 + 8 + 16。 (AAA,BBB,DDD,EEE)
  • 28意味着你已经select了4 + 8 + 16。 (CCC,DDD,EEE)

因此,如果我们想象你有这个数字,而你想要这些产品,那么这样的事情可能会起作用。 数字是lngNumber,而LngToBinary给出数字的二进制值。 在Sub TestMe ,不是打印产品,而是实际上可以对它们进行一些操作。

 Option Explicit Option Private Module Public Sub TestMe() Dim arrProducts As Variant Dim lngCounter As Long Dim lngValue As Long Dim strBinary As String Dim lngNumber As Long arrProducts = Array("AAA", "BBB", "CCC", "DDD", "EEE", "FFF", "GGG") '1, 2, 4, 8, 16, 32, 64 lngNumber = 28 '1+2+8+16 strBinary = StrReverse(LngToBinary(lngNumber)) For lngCounter = 1 To Len(strBinary) lngValue = Mid(strBinary, lngCounter, 1) If lngValue Then Debug.Print arrProducts(lngCounter - 1) End If Next lngCounter End Sub Function LngToBinary(ByVal n As Long) As String Dim k As Long LngToBinary = vbNullString If n < -2 ^ 15 Then LngToBinary = "0" n = n + 2 ^ 16 k = 2 ^ 14 ElseIf n < 0 Then LngToBinary = "1" n = n + 2 ^ 15 k = 2 ^ 14 Else k = 2 ^ 15 End If Do While k >= 1 LngToBinary = LngToBinary & Fix(n / k) n = n - k * Fix(n / k) k = k / 2 Loop End Function 

有关[FLAGS]的更多信息,请访问: https ://msdn.microsoft.com/en-us/library/system.flagsattribute( v= vs.110).aspx