Есть ли более простой / быстрый способ сделать это?

Question

For Each c In LookupRange

    Cells(c.Row, 15).Activate
    Selectedcell = ActiveCell

    If InStr(Selectedcell, "PLATE") > 0 Then
        Cells(c.Row, 18).FormulaR1C1 = "PP07"
    End If

    If InStr(Selectedcell, "PIPE") > 0 Then
        Cells(c.Row, 18).FormulaR1C1 = "PP10"
    End If

    If InStr(Selectedcell, "NUT") > 0 Then
        Cells(c.Row, 18).FormulaR1C1 = "PP02"
    End If

    If InStr(Selectedcell, "STUD") > 0 Then
        Cells(c.Row, 18).FormulaR1C1 = "PP02"
    End If

    If InStr(Selectedcell, "BOLT") > 0 Then
        Cells(c.Row, 18).FormulaR1C1 = "PP02"
    End If

    'ELSE IF
    'Cells(c.Row, 18).FormulaR1C1 = "PP07"

Next c


Cells(9, 2).Activate

Answer 1

Я только что продолжил настройку, поэтому немного минимизировать код можно:

Использование Elseif:

Option Explicit

Sub UseElseIf()

Dim LookupRange As Range
Dim c As Variant
Dim Selectedcell As Variant

Set LookupRange = Range("R1:R25")

For Each c In LookupRange
    Cells(c.Row, 15).Activate
    Selectedcell = ActiveCell
    If InStr(Selectedcell, "PLATE") > 0 Then
        Cells(c.Row, 18).FormulaR1C1 = "PP07"
    ElseIf InStr(Selectedcell, "PIPE") > 0 Then
        Cells(c.Row, 18).FormulaR1C1 = "PP10"
    ElseIf InStr(Selectedcell, "NUT") > 0 Then
        Cells(c.Row, 18).FormulaR1C1 = "PP02"
    ElseIf InStr(Selectedcell, "STUD") > 0 Then
        Cells(c.Row, 18).FormulaR1C1 = "PP02"
    ElseIf InStr(Selectedcell, "BOLT") > 0 Then
        Cells(c.Row, 18).FormulaR1C1 = "PP02"
    End If
    'ELSE IF
    'Cells(c.Row, 18).FormulaR1C1 = "PP07"
Next c

Cells(9, 2).Activate

End Sub

---

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

Sub UseCase()

Dim LookupRange As Range
Dim c As Variant
Dim Selectedcell As Variant

Set LookupRange = Range("R1:R25")

For Each c In LookupRange
Selectedcell = Cells(c.Row, 15).Value
    Select Case Selectedcell
    Case "PLATE"
        Cells(c.Row, 18).FormulaR1C1 = "PP07"
    Case "PIPE"
        Cells(c.Row, 18).FormulaR1C1 = "PP10"
    Case "NUT"
        Cells(c.Row, 18).FormulaR1C1 = "PP02"
    Case "STUD"
        Cells(c.Row, 18).FormulaR1C1 = "PP02"
    Case "BOLT"
        Cells(c.Row, 18).FormulaR1C1 = "PP02"
    End Select
    'ELSE IF
    'Cells(c.Row, 18).FormulaR1C1 = "PP07"
Next c

Cells(9, 2).Activate

End Sub

Конечно, есть более эффективные способы сокращения кодов, если мы переписываем / реструктурируем их больше.

Answer 2

Например:

Sub Tester()

    Dim c As Range, txt, res, LookupRange As Range

    Set LookupRange = Range("B7:B16") 'or whatever

    For Each c In LookupRange.Cells

        txt = c.Value
        res = ""
        Select Case True
            Case txt Like "*NUT*", txt Like "*STUD*", txt Like "*BOLT*"
                res = "PP02"
            Case txt Like "*PLATE*"
                res = "PP07"
            Case txt Like "*PIPE*"
                res = "PP10"
            Case Else
                res = "PP07"
        End Select

        c.EntireRow.Cells(18).Value = res
    Next c

End Sub

Хотя из вашего опубликованного кода не ясно, являются ли все случаи взаимоисключающими.