Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Home : Excel 2013)
複数列の一括コピペ
投稿日時: 18/02/17 20:52:59
投稿者: syu-sann

以下のようなマクロで「データ1」シートの大量のデータを「データ2」にコピーして整理しようと思っております。しかし、実行してみるとデータ数が多いこともあり、非常に時間がかかり困っております。
何か繰り返し等を使わずに、とびとびの列のデータを一括で別のシートに整理する良い方法はないでしょうか。
 
よろしくお願いいたします。
 
For i = 4 To 9000 Step 16
    Worksheets("データ1").Activate
    Worksheets("データ1").Columns(i).Select
    Selection.Copy
    Sheets("データ2").Select
    a = 3
    Columns(a).Select
    Selection.Insert Shift:=xlToRight
    Sheets("データ1").Cells(2, i).Copy Destination:=Sheets("データ2").Cells(2, a)
    a = a + 1
    Next i
End Sub

回答
投稿日時: 18/02/17 21:42:30
投稿者: WinArrow
投稿者のウェブサイトに移動

コードの中に無駄なコード、意味不明なコードがあるので、削除しましたが、
 
取り敢えず、セルの「Select」を排除したコードを提示します。
少しは早くなると思います。
 
Application.ScreenUpdating = False
For i = 4 To 9000 Step 16
     Sheets("データ1").Activate
     Sheets("データ1").Columns(i).Copy
    Sheets("データ2").Select
     a = 3
     Columns(a).Insert Shift:=xlToRight
Next i
Application.ScreenUpdating = True
 

回答
投稿日時: 18/02/17 21:44:27
投稿者: WinArrow
投稿者のウェブサイトに移動

↑より、早くするとしたら、配列変数に格納してから、
配列からデータ2シートへ一括格納
 
そうすれば、シートのActivate Seletは不要になります。

回答
投稿日時: 18/02/17 22:04:52
投稿者: WinArrow
投稿者のウェブサイトに移動

おまけ…で、配列を使ったコードを提示します。
 
Option Explicit
 
Sub test()
Dim i As Long, a As Long, j As Long
Dim data
Const 最大列 As Long = 9000
Const 間隔 As Long = 16
 
With Sheets(1)
    ReDim data(1 To .Cells(.Rows.Count, 4).End(xlUp).Row, 1 To 最大列 / 間隔)
    j = UBound(data, 2)
    For i = 4 To 最大列 Step 間隔
        For a = 1 To .Cells(.Rows.Count, i).End(xlUp).Row
            data(a, j) = .Cells(a, i).Value
        Next
        j = j - 1
    Next
End With
Sheets(2).Cells(1, 4).Resize(UBound(data), UBound(data, 2)).Value = data
End Sub

投稿日時: 18/02/18 00:36:02
投稿者: syu-sann

WinArrow 様
ご回答ありがとうございました。
配列を使用する方法は知りませんでした。まずは、コードの中身が理解できるように勉強します。
ありがとうございました。