For文で一致条件したセル範囲を配列格納行う方法について

Question

かなり初歩的な質問となってしまう可能性が高いかも知れませんが、
ネット上で検索してもそれらしき答えが出てこないためご質問させてください。

今回行いたい処理としては、
セル範囲(今回は1~54列の範囲)を変数に格納し、ループ処理で一致条件した分を
配列(Redim配列)に格納し、最終反映先(別シート)へ反映といった処理を行いたい。

1つずつの処理であれば、以下のようなイメージで上手くいくのですが・・・

tbl(i,1) = ms1.cells(i,1)
tbl(i,2) = ms1.cells(i,2)
tbl(i,3) = ms1.cells(i,3)
....
tbl(i,54) = ms1.cells(i,54)

後先の修正やコーディングに時間が掛かることや処理時間が結構要していることから
セル範囲を変数に入れて代入すれば一括で格納できるのでは・・・と
考え、最終以下のようなコードで組み立てました。

Sub 条件一致抽出反映()

'----------------------------------------
Dim wb As Workbook
Dim ms1 As Worksheet,ms2 as Worksheet

Set wb = ThisWorkbook
Set ms1 = wb.Sheets(1)'リスト
Set ms2 = wb.Sheets(2)'反映先
'----------------------------------------

mRow = ms1.Cells(Rows.Count, 1).End(xlUp).Row

Dim tb, tbl
Dim fnd1 As String, fnd2 As String
Dim rng
Dim i As Long, j As Long

j = 1
ReDim tbl(1 To mRow, 1 To 54)

For i = 3 To mRow

    fnd1 = ms1.Cells(i, 12).Value
    fnd2 = ms1.Cells(i, 10).Value
    rng = ms1.Range(ms1.Cells(i, 1), ms1.Cells(i, 54)).Value

    If Not fnd1 = "対象外" Then
        If fnd2 = "" Or fnd2 = "※" Then
            tbl(j) = rng
            j = j + 1
        End If
    End If
Next i

ms2.Range("A3:BB" & UBound(tbl)) = tbl
        
End Sub

ところが「インデックスが有効範囲にありません。」と表示されて正常に動かない状況です。
そもそもセル範囲を配列に格納すること自体が間違っている可能性は高そうな気はしており、結局は行と列(x,y)を変数にしてFor文で回す他対応はなさそうな気はしています。

また自分なりにネット上で「VBA セル範囲　一致　格納」、「VBA セル範囲　ループ 格納」等
ヒットしそうなワードを組み合わせて検索したのですがそれらしきものが見当たらず、
解決に至っておりません。

---

イメージ図

---

データ量：
A1からBB列最終行までの範囲から条件一致した分
※全体：最終行はおおよそ3万行を想定しているため、合計162万レコード程度

---

その他気になる点：
上手く伝わる自信はないのですが、
配列上の範囲（インデックス番号?)を別の配列に格納する方法はありますでしょうか。
イメージ：オブジェクト上で表した場合・・・Range(cells(i,1),cells(i,54))

Answer 1

Excelの機能を使うというのではだめでしょうか。

Sub 条件一致抽出反映()
    Dim wb As Workbook
    Dim ms1 As Worksheet, ms2 As Worksheet
    Dim mRow

    Set wb = ThisWorkbook
    Set ms1 = wb.Sheets(1) 'リスト
    Set ms2 = wb.Sheets(2) '反映先
    mRow = ms1.Cells(Rows.count, 1).End(xlUp).Row
    
    Application.ScreenUpdating = False
    With ms1.Range("A2:BB" & mRow)
        .AutoFilter Field:=12, Criteria1:="<>対象外"
        .AutoFilter Field:=10, Criteria1:="※", Operator:=xlOr, Criteria2:=""
        .Copy ms2.Range("A2")
        .AutoFilter
    End With
    Application.ScreenUpdating = True
End Sub

Comments

[quark87139]

hatenaさん
ありがとうございます！

ご提示頂いたレコードを試行テストしてみたのですが、
正しい処理結果で尚且つ処理時間もそんなにかかりませんでした。ありがとうございます。
コード自体は理解できたのですが、
VBAは同じ計算結果を求めるには複数のやり方がある中でどのように使い分けているのか差し付けなければ教えて頂けないでしょうか。（当初の質問文から逸脱しておりすみません)

オブジェクト か　オブジェクトでないかの違いで使い分ける感覚ですかね？

私のVBAに対する認識度が低いためか・・・
データ量が多ければ多いほど配列を使った方が処理速度も速くなるという思い込みをしていました。

[hatena19]

Accessの機能でできることなら、そちらを使った方が高速な場合が多いです。
コードもシンプルになる場合が多いです。
抽出や並べ替えは、AutoFilterメソッド、Sortメソッドが高速です。
処理によってはVBAが高速な場合もあります。(FindメソッドやReplaceメソッドは遅いらしい)
速度を重視するなら、両方試してみて、速い方を採用すればいいでしょう。
VBAの場合は書き方によって速度差がでるのでそれも十分検討する必要があります。

[quark87139]

大事なことを教わった気がします。本当にありがとうございます！

ご指摘頂いた通り、単に決めつけるのではなくいくつかのやり方を採用・比較し、
使いやすさや処理速度が速いなど総合的に判断して採用するやり方でこれからも検討しながら
対応していきたいと思います。

※どちらもベストアンサーにしたかったのですが、
　今回は他の方の回答が早かったので気悪くされましたら申し訳ございません。

Answer 2

こんな感じでどうでしょうか。（件数が多いとTransposeできないかも。）

Sub 条件一致抽出反映()
    
    '----------------------------------------
    Dim wb As Workbook
    Dim ms1 As Worksheet, ms2 As Worksheet
    Dim mRow
    
    Set wb = ThisWorkbook
    Set ms1 = wb.Sheets(1) 'リスト
    Set ms2 = wb.Sheets(2) '反映先
    '----------------------------------------
    
    mRow = ms1.Cells(Rows.Count, 1).End(xlUp).Row
    
    Dim tb, tbl
    Dim fnd1 As String, fnd2 As String
    Dim rng
    Dim i As Long, j As Long
    
    j = 1
    ReDim tbl(1 To mRow) ', 1 To 54)
    
    For i = 3 To mRow
    
        fnd1 = ms1.Cells(i, 12).Value
        fnd2 = ms1.Cells(i, 10).Value
        rng = ms1.Range(ms1.Cells(i, 1), ms1.Cells(i, 54)).Value
    
        If Not fnd1 = "対象外" Then
            If fnd2 = "" Or fnd2 = "※" Then
                tbl(j) = rng
                j = j + 1
            End If
        End If
    Next i
    
    ReDim Preserve tbl(1 To j - 1)
    
    With WorksheetFunction
        ms2.Range("A3:BB" & UBound(tbl) + 2).Value = .Transpose(.Transpose(tbl))
    End With

End Sub

Comments

[quark87139]

Jinojiさんありがとうございます。
特にTranposeの部分において
私自身勉強不足の部分があり申し訳ないのですが以下ご教示頂けないでしょうか。

一部抜粋↓
rng = ms1.Range(ms1.Cells(i, 1), ms1.Cells(i, 54)).Value
① tbl(j) = rng

②.Transpose(.Transpose(tbl))　

①処理：オブジェクトで言い換えると1セルの中にセル範囲の情報を格納
②処理：一次元配列から二次元配列に変換して一次元配列に変換？
上記の認識ですが相違ないでしょうか？②の処理がイマイチつかめていないです。。

また個人的には1つ（セル)ずつの処理を行う形であれば配列が適している印象ですが、
今回のような複数範囲を一括で処理を行うのは配列に向いていないんですかね？

[jinoji]

②の処理はちょっと説明しづらいのですが、おおよそ以下の感じです。
WorksheetFunction.Transposeはもともと「セル範囲の行と列を入れ替えて貼り付け」的な機能で、
基本的には二次元配列に対して行うものなのですが、
今回のような「一次元配列の各要素が一次元配列になっているもの」にも何故か機能し、
しかも結果が二次元配列に変換されている、という仕様なので、
配列をセル範囲に書き戻すときにこれを利用する（行列が入れ替わるので二度掛けする）のが
いにしえより伝わるExcelVBAの謎テクニックなのです。

一定の上限（おそらくその出自から列の最大数）を超える要素数には対応できないなどの制約があり、
使い方を誤るとハマりますが、うまく使うとハマります。

[quark87139]

ご返信遅くなり申し訳ございません。
当初ご提示頂いたコードを拝見した際、Tranposeを続けて使ったら元に戻るのでは・・・と思っていたので分かりやすい説明頂いた理解できました。分かりやすい説明頂きありがとうございます。

また一定の上限を超えた場合、上手く作動しない場合もあるとのこと留意の上うまく使い分けてみます。