[[20111203095710]]　『配列の入れ子』（バーバラ）　ページの最後に飛ぶ

 『配列の入れ子』（バーバラ）

 おはようございます。また、お世話になります。
 WinXP、Excel2007です。

 以前、下記の質問をさせていただきました。
 [[20110911100955]]　『マクロの簡素化』（バーバラ）
 この内容を踏まえての質問なのですが、日があいてしまったため新規に立てさせていただきます。

	[A]	[B]	[C]	[D]	[E]	[F]	[G]	
 [1]　  12　　　13　　　 14             15       16       17
 [2]		       
 [3]		       	
 [4]		       						
 [5]	22	23       24	        25       26       27
 [6]	
 [7]		       
 [8]	32       33       34            35       36       37
 [9]		       
 [10]	42       43       44            45       46       47

 上記のようなデータがあり、これらをC20:E23、G20;I23にそれぞれコピペするために
 次のようなコードを書きました（Mookさんに教えていただいた考え方を上記の例に
 合わせこみました）。
 ｺｺとｺｺの間を配列を入れ子にしてさらにまとめられるのではないかと思うのですが
 どうすればいいか教えていただけないでしょうか。
 Sub Sample()

    Dim srcRow As Variant
    Dim srcCol As Variant
    Dim dstCol As Variant
    Dim dstRow As Variant
    Dim arCol As Long
    Dim ar(1 To 1, 1 To 3)
    Dim fromTo As Variant
    Dim WS As Worksheet
    Set WS = ActiveWorkbook.Sheets("Sheet1")

    For Each fromTo In Array(Array(1, 20), Array(5, 21), Array(8, 22), Array(10, 23))
        srcRow = fromTo(0)
        dstRow = fromTo(1)

        arCol = 1                               ------------------ｺｺ
        For Each srcCol In Array("A", "B", "C")
            ar(1, arCol) = WS.Cells(srcRow, srcCol).Value
            arCol = arCol + 1
        Next srcCol
        WS.Cells(dstRow, "C").Resize(1, 3) = ar

        arCol = 1
        For Each srcCol In Array("E", "F", "G")
            ar(1, arCol) = WS.Cells(srcRow, srcCol).Value
            arCol = arCol + 1
        Next srcCol
        WS.Cells(dstRow, "G").Resize(1, 3) = ar
                                               ------------------ｺｺ
    Next fromTo
 End Sub
 （バーバラ）

 配列の入れ子、の意味がよく理解できていませんが（Jugged Arrayのこと？)

 簡素化するのならこういう方法も。

 Sub Sample()
    Dim myRow As Variant
    Dim myCol As Variant
    Dim ar() As Variant
    Dim i As Long
    Dim ii As Long
    Dim WS As Worksheet
    Set WS = ActiveWorkbook.Sheets("Sheet1")
    myRow = VBA.Array(1, 5, 8, 10)
    myCol = VBA.Array("A", "B", "C", "E", "F", "G")
    ReDim ar(UBound(myRow), UBound(myCol))
    For i = 0 To UBound(myRow)
        For ii = 0 To UBound(myCol)
            ar(i, ii) = WS.Cells(myRow(i), myCol(ii)).Value
        Next
    Next
    WS.Cells(20, "c").Resize(UBound(myRow) + 1, UBound(myCol) + 1).Value = ar
    Set WS = Nothing
 End Sub
 (seiya)

 seiyaさん
 ご回答ありがとうございます。
 >配列の入れ子、の意味がよく理解できていませんが
 要は、コードを簡素化したい、ということなので、あまり気にしないでください。。。

 書いていただいたコードを実行すると、
 「E1:G1」「E5:G5」「E8:G8」「E10:G10」の貼り付け先が「F20:H23」になっています。
 これを１列ずらして「G20:I23」に貼り付けたいのですが、その場合はどうすればよいでしょうか。
 コードはこれから解読してみます。
 （バーバラ）

 こういうことですか？
 抽出先のＦ列に何かデータがある場合は空白にしてしまいますので
 注意してください。
 Sub Sample()
    Dim myRow As Variant
    Dim myCol As Long
    Dim ar() As Variant
    Dim i As Long
    Dim ii As Long
    Dim WS As Worksheet
    Set WS = ActiveWorkbook.Sheets("Sheet1")
    myRow = VBA.Array(1, 5, 8, 10)
    ReDim ar(UBound(myRow), 7)
    For i = 0 To UBound(myRow)
        For myCol = 1 To 7
            If myCol <> 4 Then
                ar(i, myCol - 1) = WS.Cells(myRow(i), myCol).Value
            End If
        Next
    Next
    WS.Cells(20, "c").Resize(UBound(myRow) + 1, 7).Value = ar
    Set WS = Nothing
 End Sub
 (seiya)

 seiyaさん
 ご回答ありがとうございます。
 >抽出先のＦ列に何かデータがある場合は空白にしてしまいますので
 >注意してください。
 実際のファイルでは、F列に相当する部分には集計セルが入っているので、
 できればF列を空白にせずに、ピンポイントでデータのコピペをしたいのです。
 （バーバラ）

 Subルーチンプロシージャでは？

 Sub Sample_2()

    Dim FromTo As Variant
    Dim WS As Worksheet

    Set WS = ActiveWorkbook.Sheets("Sheet1")

    For Each FromTo In Array(Array(1, 20), Array(5, 21), Array(8, 22), Array(10, 23))
        DataOut FromTo, WS, "C", Array("A", "B", "C")
        DataOut FromTo, WS, "G", Array("E", "F", "G")
    Next FromTo

 End Sub

 Private Sub DataOut(FromTo As Variant, wksResuit As Worksheet, _
                        strPos As String, vntColumns As Variant)

    Dim srcRow As Variant
    Dim srcCol As Variant
    Dim arCol As Long
    Dim dstRow As Variant
    Dim ar(1 To 1, 1 To 3)

    srcRow = FromTo(0)
    dstRow = FromTo(1)

    arCol = 1
    For Each srcCol In vntColumns
        ar(1, arCol) = wksResuit.Cells(srcRow, srcCol).Value
        arCol = arCol + 1
    Next srcCol
    wksResuit.Cells(dstRow, strPos).Resize(1, 3) = ar

 End Sub

 (Bun)

 そういうことなら、単純に

 Sub Sample()
    Dim myRow As Variant
    Dim myCol As Long
    Dim WS As Worksheet
    Set WS = ActiveWorkbook.Sheets("Sheet1")
    For Each myRow In Array(Array(1, 22), Array(5, 23), Array(8, 24), Array(10, 25))
        For myCol = 1 To 7
            If myCol <> 4 Then
                WS.Cells(myRow(1), myCol + 2).Value = WS.Cells(myRow(0), myCol).Value
            End If
        Next
    Next
    Set WS = Nothing
 End Sub
 とか？
 (seiya)

 Bunさん、seiyaさん
 ご回答ありがとうございました。
 お二人のいずれのやり方でも動きました。
 実際のファイルでの運用を考えた場合、Bunさんのやり方の方がなじんでいるようなので、
 そちらを使わせていただきます。

 サブルーチンというのは、ユーザー定義関数みたいなものなんですね。
 もう少しコード読んでみます。
 （バーバラ）

 おまけ、
 簡素化が目的なら

 Sub Sample()
Dim e, v
For Each e In Array(Array(20, 1), Array(21, 5), Array(22, 8), Array(23, 10))
    For Each v In Array(Array("c", "a"), Array("g", "e"))
        Cells(e(0), v(0)).Resize(, 3).Value = Cells(e(1), v(1)).Resize(, 3).Value
    Next
Next
End Sub
(seiya)

 seiyaさん
 おまけありがとうございます。
 これが私のイメージしていたものでした！
 シンプルで素晴らしいです。
 （バーバラ）

コメント返信：

[ 一覧(最新更新順) ]

[[20111203095710]] 『配列の入れ子』（バーバラ） ページの最後に飛ぶ

[[20111203095710]]　『配列の入れ子』（バーバラ）　ページの最後に飛ぶ