| |
▼みかん さん：
一応、↑でコメントした 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
|
|
独覚
- 15/1/5(月) 13:17 -
nossa
- 15/1/5(月) 10:10 -
みかん
- 14/12/31(水) 14:46 -
