vba 循环遍历列并将值从单元格复制到数组中

Looping through a column and copying values from cell into an array

提问by Some user

So i am really new to excel and I am trying to copy some values in a cell into an array and later display the array in a column. So what I have is a list of first names in a column(A).Then I have a list of numbers next to the names in column(B). So what I am trying to do is loop through the numbers and if any of the numbers equals 4. copy the name corresponding to the number into my array. and later display that array lets say in column D. This is what I have so far.

所以我对 excel 真的很陌生，我试图将单元格中的一些值复制到一个数组中，然后在列中显示该数组。所以我有一个列（A）中的名字列表。然后我在列（B）中的名称旁边有一个数字列表。所以我想要做的是循环遍历数字，如果任何数字等于 4。将与数字对应的名称复制到我的数组中。然后在 D 列中显示该数组。这就是我目前所拥有的。

    Option Explicit

    Public Sub loopingTest()

    Dim FinalRow As Long '
    Dim i As Long 'varable that will loop through the column
    Dim maxN As Integer 'variable that will hold the maximum number
    Dim j As Long 'variable that will hold the index of the array
    Dim ArrayTest As Variant

    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row ' will get the last row

   For i = 1 To FinalRow 'loop until the last row

      If Range("B" & i) = 4 Then 'if any of the values of column B matches 4 then
        ArrayTest(j) = Range("A" & i) 'copy the value corresponding to column A to the array
        j = j + 1 'increment array index

     End If 'end of endif

     Next i 'increment column

     'output array into column D
     For x = 1 to FinalRow
        Range("D" & x)  = ArrayTest(x)
      Next x

     End Sub

Would this be a correct way of doing this? Also if I would update column B to any numbers I would love column D to update automatically. Any help would be appreciated

这是这样做的正确方法吗？此外，如果我将 B 列更新为任何数字，我希望 D 列能够自动更新。任何帮助，将不胜感激

回答by

Use WorksheetFunction.Transpose(Array)method to print an array to spreadsheet. It's an efficient (and built-in) method widely used to print an array to a spreadsheet in one go.

使用WorksheetFunction.Transpose(Array)方法将数组打印到电子表格。这是一种高效（且内置）的方法，广泛用于一次性将数组打印到电子表格。

Avoid comments like End if 'end of end ifas anybody reading your code will know that already. More about the DRYprinciple.

避免注释，End if 'end of end if因为任何阅读您代码的人都已经知道这一点。更多关于DRY原则的信息。

The downside of VBA Arrays is that you always have to specify the size at the creation time. It's a long topic and there are alternative ways, avoiding arrays etc, but I am not going to discuss it here. A workaround is to start at 0and then resize(increase) the array as you go using ReDim Preserve

VBA 数组的缺点是您总是必须在创建时指定大小。这是一个很长的话题，有替代方法，避免数组等，但我不打算在这里讨论它。一种解决方法是开始使用，0然后在使用时调整（增加）数组的大小ReDim Preserve

Public Sub loopingTest()

    Dim lastRow As Long
    Dim i As Long
    ReDim ArrayTest(0)

    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row ' will get the last row

    For i = 1 To lastRow

        If Range("B" & i) = 4 Then 'if any of the values of column B matches 4 then

            ArrayTest(UBound(ArrayTest)) = Range("A" & i) 'copy the value corresponding to column A to the array
            ReDim Preserve ArrayTest(UBound(ArrayTest) + 1)

        End If

    Next i

    Range("D1:D" & UBound(ArrayTest)) = WorksheetFunction.Transpose(ArrayTest)

End Sub

now a short version of your code would be

现在您的代码的简短版本将是

Public Sub loopingTest()
    Dim i As Long: ReDim ArrayTest(0)
    For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        If Range("B" & i) = 4 Then
            ArrayTest(UBound(ArrayTest)) = Range("A" & i)
            ReDim Preserve ArrayTest(UBound(ArrayTest) + 1)
        End If
    Next i
    Range("D1:D" & UBound(ArrayTest)) = WorksheetFunction.Transpose(ArrayTest)
End Sub

Update:

更新：

You can use a variable instead of 4

您可以使用变量代替 4

Public Sub loopingTest()

    Dim lastRow As Long
    Dim myNumber as Long
    myNumber = 5
    Dim i As Long
    ReDim ArrayTest(0)

    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row ' will get the last row

    For i = 1 To lastRow

        If Range("B" & i) = myNumber Then 

            ArrayTest(UBound(ArrayTest)) = Range("A" & i) 
            ReDim Preserve ArrayTest(UBound(ArrayTest) + 1)

        End If

    Next i

    Range("D1:D" & UBound(ArrayTest)) = WorksheetFunction.Transpose(ArrayTest)

End Sub

回答by JosieP

purely for information you could do the same without looping using something like

纯粹为了信息，你可以做同样的事情而不用循环使用类似的东西

Public Sub nonloopingTest()

   Dim lastRow                     As Long
   Dim myNumber                    As Long
   Dim vOut

   myNumber = 5

   lastRow = Cells(Rows.Count, 1).End(xlUp).Row   ' will get the last row
   vOut = Filter(ActiveSheet.Evaluate("TRANSPOSE(if(B1:B" & lastRow & "=" & myNumber & ",A1:A" & lastRow & ",""||""))"), "||", False)
   If UBound(vOut) > -1 Then Range("D1").Resize(UBound(vOut) + 1) = WorksheetFunction.Transpose(vOut)

End Sub