VBA - Как взять один столбец в качестве входного массива, а затем вывести массив, удалив все нечетные числа

Question

У меня очень простой вопрос, но хотелось бы знать, как это сделать.Я хочу написать функцию в VBA, где я могу выделить столбец в качестве входных данных, а затем выплюнуть результат в другом месте.

Заранее спасибо:)

например, столбец A -------- 10 8 5 6 1 3 2

становится:

 column A
  --------
    10
    8
    6
    2

Answer 1

Я только что сделал это от столбца a до b, но вы, вероятно, хотите диапазон в качестве текущего выбора и другой выходной столбец.

Option Explicit

Sub filterlist()
Dim rng As Range
Set rng = Range("a1:a5")
Dim celluse As Range
Dim arr As Variant

For Each celluse In rng
    If celluse.Value Mod 2 = 0 Then
        If IsEmpty(arr) Then
            arr = Array(celluse.Value)
        Else
            ReDim Preserve arr(UBound(arr) + 1)
            arr(UBound(arr)) = celluse.Value
        End If
    End If
Next celluse


Dim i As Long    
For i = 0 To UBound(arr)    
    Range("b" & i + 1) = arr(i)
Next i


End Sub

Answer 2

Этот код должен помочь.
Вы можете ввести как формулу массива непосредственно на лист: {=RemoveOdds(A1:A7)} или как часть другой процедуры:

Sub Test()
    RemoveOdds Selection
End Sub 

---

Public Function RemoveOdds(Target As Range) As Variant

    Dim vFinal() As Variant
    Dim rCell As Range
    Dim x As Long

    ReDim vFinal(1 To Target.Cells.Count)

    x = 1
    For Each rCell In Target
        If rCell Mod 2 = 0 Then
            vFinal(x) = rCell.Value
            x = x + 1
        End If
    Next rCell

    'So missing values do not show up as 0 at bottom of array.
'    Do While x <= Target.Cells.Count
'        vFinal(x) = ""
'        x = x + 1
'    Loop

    ReDim Preserve vFinal(1 To x - 1)

    'RemoveOdds = vFinal 'Basic array - will place values horizontally on sheet.
    RemoveOdds = Application.Transpose(vFinal) 'Will place values vertically on sheet.

End Function