一次填充一个值的数组

Question

我想遍历列中的每个单元格，如果满足条件，则将其放入下一个可用的数组元素中。

我有第一部分，但我不知道如何将满足 IF 语句标准的每个元素放入一个数组中，然后转置该数组。

Option Explicit
Private Sub Workbook_Open()

Dim StepCheck As Range
Dim ImporterName As Variant
Dim ws As Worksheet
Dim NameRange As Range

Set ws = Workbooks.Open(Filename:="Filepath goes here").Sheets("Sheet1")

For Each StepCheck In ws.Range("F1:F" & ws.Cells(ws.Rows.Count, "F").End(xlUp).Row)

    If IsError(StepCheck.Value) Then
        If Err.Number <> 0 Then
            Err.Clear
            On Error GoTo 0
        End If
        
    ElseIf StepCheck.Value = "5" Then

        ImporterName = StepCheck.Offset(0, -5).Value
    
    End If
Next

End Sub

当每个 StepCheck 满足 IF 语句条件时，如何将其存储到数组导入器名称中？

代码运行但不会将所有 StepCheck 条目存储到数组中，而是在每个循环中都被覆盖。

Answer 1

匹配数据

• 它将在一维数组中从F 列中的值等于5 的行返回A 列的值，并在“立即”窗口中打印其内容。

Option Explicit

Sub MatchData()

    ' (Open and) Reference the workbook ('wb').
    Dim wb As Workbook: Set wb = Workbooks.Open("C:TestTest.xlsx")
    ' For the workbook containing this code, use:
    'Dim wb As Workbook: Set wb = ThisWorkbook
    
    ' Reference the worksheet ('sws').
    Dim sws As Worksheet: Set sws = wb.Worksheets("Sheet1")
    
    ' Write the values from the source lookup column
    ' to a 2D one-based one-column array ('slData').
    
    Dim slrg As Range
    Set slrg = sws.Range("F1", sws.Cells(sws.Rows.Count, "F").End(xlUp))
    Dim srCount As Long: srCount = slrg.Rows.Count
    
    Dim slData() As Variant
    If srCount = 1 Then
        ReDim slData(1 To 1, 1 To 1): slData(1, 1) = slrg.Value
    Else
        slData = slrg.Value
    End If
    
    ' Write the values from the source value column
    ' to a 2D one-based one-column array ('svData').
    
    Dim svrg As Range: Set svrg = slrg.EntireRow.Columns("A")
    
    Dim svData() As Variant
    If srCount = 1 Then
        ReDim svData(1 To 1, 1 To 1): svData(1, 1) = svrg.Value
    Else
        svData = svrg.Value
    End If
    
    ' Write the required values from the source values array
    ' to a 1D one-based array ('dArr').
    
    Dim dArr() As Variant: ReDim dArr(1 To srCount) ' too big
    Dim sValue As Variant
    Dim sr As Long
    Dim dc As Long
    
    For sr = 1 To srCount
        sValue = slData(sr, 1)
        If VarType(sValue) = vbDouble Then ' is a number
            If sValue = 5 Then ' is equal to 5
                dc = dc + 1
                dArr(dc) = svData(sr, 1)
            ' Else ' is a number but not equal to 5; do nothing
            End If
        ' Else ' is not a number; do nothing
        End If
    Next sr
    
    ' Resize the destination array (remove the trailing 'empties').
    ReDim Preserve dArr(1 To dc)

    ' Print the contents of the array to the Immediate window ('Ctrl+G').
    Debug.Print "Index", "Value"
    For dc = 1 To UBound(dArr)
        Debug.Print dc, dArr(dc)
    Next dc
 
End Sub