2次元配列に連続で格納されてる値を一括でコピーしシートへ貼り付ける

配列に格納されている値のうち条件にあうデータのみを一括でシートへ書き出す方法です。

文字の先頭が「0」で始まる場合は、「Line Input」または「QueryTable」の方法があります。

【参考】　大量データのCSVファイルを読み込み後、2次元配列に連続で格納されてる値を一括でコピーしシートへ貼り付ける方法 

一括コピーの例

シートは3つです。

シート「設定」

書き出すデータの条件設定をするシートです。

セルA2以降に条件を入力します。条件はシート「データ」の1行目・2列目以降の値です。

シート「データ」

黄色のセルのデータを書き出します。

シート「設定」で条件指定したデータは、C列とE列です。

ｋ200 をローカルウィンドウで見た場合

シート「出力」

条件に合ったデータを書き出します。

条件に存在しない値を設定した場合

存在しない値を飛ばして出力します。

サンプルコード

Sub sample()
    Dim ws1 As Worksheet: Set ws1 = Worksheets("設定")
    Dim ws2 As Worksheet: Set ws2 = Worksheets("データ")
    Dim ws3 As Worksheet: Set ws3 = Worksheets("出力")
        
    Dim joken As Variant: joken = ws1.Range("A1").CurrentRegion
    Dim tmp As Variant: tmp = ws2.Range("A1").CurrentRegion
    Dim out As Variant
    ReDim out(LBound(tmp) To UBound(tmp)) As Variant
    
    Dim i As Long, r As Long, c As Long, cnt As Long
    
    For r = LBound(tmp) To UBound(tmp)
       out(r) = tmp(r, 1)
    Next r
    
    With ws3
       .Range(.Cells(1, 1), .Cells(UBound(tmp), 1)) = _
                             WorksheetFunction.Transpose(out)
    End With
    
    cnt = 2
    For i = 2 To UBound(joken)
        For c = 2 To UBound(tmp, 2)
            If joken(cnt, 1) = tmp(1, c) Then
                For r = LBound(tmp) To UBound(tmp)
                    out(r) = tmp(r, c)
                Next r
                With ws3
                    .Range(.Cells(1, cnt), .Cells(UBound(tmp), cnt)) = _
                                            WorksheetFunction.Transpose(out)
                End With
                cnt = cnt + 1
                Exit For
            End If
        Next c
    Next i
    MsgBox "終了"
End Sub

6行目の条件は1次元配列で格納する方法もあり。

 Dim joken As Variant: joken = ws1.Range("A1").CurrentRegion

25行目はStrComp関数でも値を探すことができます。

If StrComp(tmp(1, c), joken(i, 1)) = 0 Then
  処理
End If