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

时间:2013-08-15 08:19:30

标签: arrays excel vba excel-vba

所以我真的是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

这是一种正确的方法吗?此外,如果我将B列更新为任何数字,我希望D列自动更新。任何帮助将不胜感激

2 个答案:

答案 0 :(得分:3)

使用WorksheetFunction.Transpose(Array)方法将数组打印到电子表格。它是一种高效的(和内置)方法,广泛用于一次将数组打印到电子表格

避免像End if 'end of end if这样的评论,因为任何阅读代码的人都会知道。有关DRY原则的更多信息。

VBA Arrays的缺点是你必须在创建时指定大小。这是一个很长的话题,还有其他方法,避免数组等,但我不打算在这里讨论它。解决方法是从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

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

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

更新:

您可以使用变量而不是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

答案 1 :(得分:1)

纯粹是为了获取信息,你可以使用

之类的东西进行循环
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