Цитирование через столбец и копирование значений из ячейки в массив

Question

Так что я действительно новичок в 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 для автоматического обновления. Любая помощь была бы оценена

Answer 1

Используйте метод 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 

Update:

Вы можете использовать переменную вместо 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 

Answer 2

чисто для информации, которую вы могли бы сделать то же самое без зацикливания, используя что-то вроде

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