Как я могу сделать этот блок сообщений только с циклами и заявлениями?

Question

введите описание изображения здесь

        Sub RollerCoaster()

        Dim strCoaster As String
        Dim strType As String
        Dim blnFound As Boolean
        Dim intWood As Integer

        Range("A2").Select


        strType = "Wood"
        blnFound = False


        Do Until ActiveCell.Value = ""
        strCoaster = ActiveCell.Offset(1, 0).Value
            If ActiveCell.Offset(0, 2).Value = strType Then
                strCoaster = ActiveCell.Value
                MsgBox ("The RollerCoaster made out of woods is " & strCoaster)
                blnFound = True
                Exit Do
            Else
                ActiveCell.Offset(1, 0).Select
            End If
        Loop

        End Sub

Я знаю, как сделать цикл только для 1 американских горок, но как я могу получить все американские горки типа Wood в окне сообщения?

Answer 1

Как-то так (не нужно выбирать / активировать)

Sub RollerCoaster()

    Dim strType As String
    Dim c As Range, msg 

    strType = "Wood"
    msg = ""

    Set c = ActiveSheet.Range("A2") 
    Do While Len(c.Value) > 0 = ""
        If c.Offset(0, 2).Value = strType Then
            msg  = msg & vbLf & c.Value
        End If
        Set c = c.Offset(1, 0)
    Loop

    If Len(msg) > 0 Then Msgbox "Found matches:" & msg

End Sub

Answer 2

Вот что вы просите меня показать ...

 Dim MyType As Variant
 MyType = Array("Wood", "Soil", "Cement", "Brick")
 For mycnt = 1 To UBound(MyType)
     strType = MyType(mycnt - 1)
     blnFound = False
     'Your do loop here
 Next