VBA セル範囲配列処理について

Question

VBA セル範囲を配列で処理

VBAでデータが入力されているセル範囲を配列に格納し、
不要行を削除（A列にデータが無い行を削除）した後、
配列に格納し処理したデータを、張り付ける処理を
したいのですが、コード中の⑤の処理が、どうしても
分からない状況ですのでご教示願います

Sub sample01()
    Dim rng As Range
    Dim rngAry As Variant
    Dim maxRow As Long
    
'    ①A列の最終行を取得
    maxRow = Cells(Rows.Count, "A").End(xlUp).Row
    
'    ②データが格納されている範囲をrngに格納
    Set rng = Range("A1: C" & maxRow)
    
    Debug.Print maxRow
    
'    ③rngを配列に格納
    rngAry = rng.Value
    
'    ④A列にデータがある場合だけaryに配列としてA列、B列、C列のデータを格納
    Dim i As Long
    Dim ary As Variant
    For i = 1 To maxRow
        If rngAry(i, 1) <> "" Then
            ary = Array(Cells(i, "A"), Cells(i, "B"), Cells(i, "C"))
        End If
    Next i
    
'    ⑤上記で取得したデータをF列～H列に貼り付け

End Sub

Comments

[okakemetal]

aryをRedimで２次元配列にしてrngAryの値を判定して、条件に合致したらaryに格納
格納が完了したaryを、セルF1に貼り付けでできないでしょうか？

Answer 1

配列では1行を一度に挿入できないので、先に出力用配列のサイズを決定しておいて、一つずつ代入していくことになります。

Public Sub sample02()
    Dim rngAry As Variant
    rngAry = Cells(1).CurrentRegion.Value        'A1を含むデータのある矩形範囲を配列に
    Dim rowSize As Long, colSize As Long
    rowSize = UBound(rngAry): colSize = UBound(rngAry, 2)
    Dim ary As Variant
    ReDim ary(1 To rowSize, 1 To colSize)
    
    Dim i As Long, j As Long, k As Long
    For i = 1 To rowSize
        If rngAry(i, 1) <> "" Then
            k = k + 1
            For j = 1 To colSize
                ary(k, j) = rngAry(i, j)
            Next
        End If
    Next
    
    Range("F1").Resize(rowSize, colSize).Value = ary
End Sub

別案
SpecialCells(xlCellTypeConstants) で値のあるセルを取得して、Unionで纏めて、コピーする。

Public Sub sample03()
    Dim rng As Range, colSize As Long
    Set rng = Cells(1).CurrentRegion
    colSize = rng.Columns.Count
    Set rng = rng.SpecialCells(xlCellTypeConstants)
    
    Dim r As Range, rng2 As Range
    For Each r In rng
        If rng2 Is Nothing Then
            Set rng2 = r.Resize(, colSize)
        Else
            Set rng2 = Union(rng2, r.Resize(, colSize))
        End If
    Next
    
    rng2.Copy Range("F1")
End Sub