|    | 
     ▼みかん さん: 
 
一応、↑でコメントした Index関数を使った処理案です。 
各プロシジャで、最初にテストデータとして、A1:J1000 に値をセットしていますが 
ここは、処理効率とは無縁のところですから、割り引いてください。 
エクセルのメモリー内での内部処理を利用していますので、効率はいいと思います。 
 
いずれもA1:J1000の内容を配列 v に取り込み、そこから抜出必要部分を 
配列 w として生成。この配列 w をM1から始まるセル領域に一括で落とし込みます。 
 
配列 v から配列 w を生成するところは、外だしのFunctionプロシジャにできますし 
そうしておけば再利用に便利でしょうね。 
 
(この配列生成方法は、以前に別掲示板で紹介されていたものです) 
 
新規のブックの標準モジュールに以下をコピーして試してみてください。 
 
'配列の指定列の全行を転記 
Sub TestbyCol() 
  Dim v As Variant 
  Dim w As Variant 
   
  testdata  'テストデータ生成 
   
  'セル領域を配列に格納 
  v = Range("A1").CurrentRegion.Value 
  '2列目、4列目、6列目、8列目を指定 
  w = Application.Index(v, Evaluate("row(1:" & UBound(v, 1) & ")"), Array(2, 4, 6, 8)) 
   
  Range("M1").Resize(UBound(w, 1), UBound(w, 2)).Value = w 
   
End Sub 
 
'配列の指定行の全列を転記 
Sub TestbyRow() 
  Dim v As Variant 
  Dim w As Variant 
   
  testdata  'テストデータ生成 
   
  'セル領域を配列に格納 
  v = Range("A1").CurrentRegion.Value 
  '行を抜きだすために、いったん行列入れ替え 
  v = WorksheetFunction.Transpose(v) 
  '2行目、4行目、5行目を指定 
  w = Application.Index(v, Evaluate("row(1:" & UBound(v, 1) & ")"), Array(2, 4, 5)) 
  '再度反転し元の行列の形式に 
  w = WorksheetFunction.Transpose(w) 
   
  Range("M1").Resize(UBound(w, 1), UBound(w, 2)).Value = w 
   
End Sub 
 
'配列の連続した指定行の指定列を転記 
Sub testbyRowCol1() 
  Dim v As Variant 
  Dim f As Long 
  Dim t As Long 
  Dim w As Variant 
   
  testdata  'テストデータ生成 
   
  'セル領域を配列に格納 
  v = Range("A1").CurrentRegion.Value 
  '抜き出し 開始行 4行目 から 終了行 8行目 
  f = 4 
  t = 8 
  '2列目、4列目、6列目、8列目を指定 
  w = Application.Index(v, Evaluate("row(" & f & ":" & t & ")"), Array(2, 4, 6, 8)) 
   
  Range("M1").Resize(UBound(w, 1), UBound(w, 2)).Value = w 
 
End Sub 
 
'配列内のとびとびの行、列を指定して転記 
Sub testbyRowCol2() 
  Dim v As Variant 
  Dim w As Variant 
   
  testdata  'テストデータ生成 
   
  'セル領域を配列に格納 
  v = Range("A1").CurrentRegion.Value 
  v = WorksheetFunction.Transpose(v) 
  '2列目、4列目、6列目、8列目を指定 
  w = Application.Index(v, Evaluate("row(1:" & UBound(v, 1) & ")"), Array(2, 4, 6, 8)) 
  '行を抜きだすために、いったん行列入れ替え 
  w = WorksheetFunction.Transpose(w) 
  '2行目、4行目、5行目を指定 
  w = Application.Index(w, Evaluate("row(1:" & UBound(w, 1) & ")"), Array(2, 4, 5)) 
   
  Range("M1").Resize(UBound(w, 1), UBound(w, 2)).Value = w 
 
End Sub 
 
Sub testdata() 
  Dim i As Long, j As Long 
  Dim v(1 To 30, 1 To 10) As String 
  Cells.Clear 
   
  For i = 1 To 1000 
    For j = 1 To 10 
      Cells(i, j).Value = Cells(i, j).Address 
    Next 
  Next 
   
End Sub 
 
 | 
     
    
   |