Вложенный вариант выбора для нескольких условий

Часть 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

Case может быть вложен таким же образом, как 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

Вероятно, это не то, что вы ожидали в качестве ответа, но логика работает безупречно, если вы примените ее к своему делу.

Предположим, что Microsoft регулярно обновляла VBA. По крайней мере так же часто, как C#. Тогда у нас было бы что-то под названием [FLAGS], и эта задача была бы очень простой. Однако у нас его нет, поэтому мы должны построить что-то подобное в одиночку.

Представьте, что у вас есть 7 продуктов (AAA, BBB, CCC, DDD, EEE, FFF, GGG) и вы хотите знать, какой из них вы выбрали. Я предполагаю, что это ядро ​​​​вашей проблемы. Это довольно просто, если использовать бинарную математику: тогда первому произведению присваивается значение 1, второму — 2, третьему — 4, четвертому — 8 и т. д.

• 27 означает, что вы выбрали 1+2+8+16. (ААА, ВВВ, DDD, ЕЕЕ)
• 28 означает, что вы выбрали 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