2

所以我对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 列自动更新。任何帮助，将不胜感激

4

2 回答 2

3

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

避免评论，End if 'end of end if因为任何阅读您的代码的人都会知道这一点。更多关于DRY原则。

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

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

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
于 2013-08-15T08:28:22.830 回答
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
于 2013-08-15T09:40:24.480 回答