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的速度要快得多。使用Union收集合格范围，然后将值连接起来要稍微复杂一点，因为并集范围可能不包含连续范围，您可以轻松地为索引，转置和连接成字符串。

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

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

1 个答案: