循环遍历单元格并使用无限循环在消息框中显示值

Question

我正在编写一段代码，该代码循环遍历列中的所有值（直到它到达空行）并将包含“Wooden”的值添加到要在消息框末尾显示的范围内。

在链接Here 的图像中，它将从 A2 开始并向下每一行，检查 C 列中该过山车的值，如果 C 是木制的，则将 A 中的值添加到要显示的范围结束。

代码：

 Sub checktype()
 Dim wooden As Range
 Range("A2").Select
 Do While ActiveCell.Value <> ""
     If ActiveCell.Offset(0, 2).Value = "Wood" Then
         If wooden Is Nothing Then
             Set wooden = ActiveCell
         Else
             Set wooden = Union(wooden, ActiveCell)
         End If
     End If
     ActiveCell.Offset(1, 0).Select
 Loop
 MsgBox wooden
 End Sub

但是，代码只返回“Grand National”——C 列中第一个有木头的条目。

Answer 1

我会使用数组来更快地处理，并且我认为您需要字符串值，因此您不需要合并范围，而是连接符合条件的单元格的值。使用数组并避免使用.Select 会快很多。 使用联合收集符合条件的范围，然后将值连接起来稍微复杂一些，因为联合范围可能不包含您可以轻松索引、转置和连接成字符串的连续范围。

Option Explicit
Public Sub checktype()
    Dim wooden As String, loopRange As Range, arr(), i As Long
    With ThisWorkbook.Worksheets("Sheet1") '<== change to your sheet
        Set loopRange = .Range(.Range("A2"), .Range("A2").End(xlDown))
        Set loopRange = loopRange.Resize(loopRange.Rows.Count, 3)

        If loopRange.Count = 1 Then
            ReDim arr(1, 1): arr(1, 1) = .Range("A2").Value
        Else
            arr = loopRange.Value
        End If

        For i = LBound(arr, 1) To UBound(arr, 1)
            If arr(i, 3) = "Wood" Then
                wooden = wooden & Chr$(32) & arr(i, 1)
            End If
        Next
    End With
    Msgbox wooden
End Sub