質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

配列

配列は、各データの要素(値または変数)が連続的に並べられたデータ構造です。各配列は添え字(INDEX)で識別されています。

Q&A

解決済

2回答

1300閲覧

Excel のデータ整理マクロ(データを別シートに転記)をスピードアップしたい。

Hiroms

総合スコア17

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

配列

配列は、各データの要素(値または変数)が連続的に並べられたデータ構造です。各配列は添え字(INDEX)で識別されています。

0グッド

1クリップ

投稿2021/04/01 09:35

前提・実現したいこと

excelに出力された時系列データがありますが、
データの並び順が特殊なため、整理するマクロを作成しました。
希望通りの動作にはなってはいますが、実行にとても時間がかかってしまうため
処理速度を上げたいです。
方法がわかりませんので、アイデアなどをいただけますと助かります。

<時系列データの構成>
イメージ説明
右から左、上から下にデータが時系列で入力されている。

<出力イメージ>
イメージ説明
別シートに縦1列で時系列順にデータを並べたい。

発生している問題・エラーメッセージ

実際は元データは 100列x1000行 程度の量があります。
この処理に数分~数十分かかってしまいます。

該当のソースコード

VBA

1Sub Macro1() 2 3Application.ScreenUpdating = False 4 5Dim startrow As Integer 'データの最初の行 6startrow = 5 7 8Dim endrow As Integer 'データの最後の行 9endrow = 1007 10 11Dim firstrow As Integer 'データ整理シートの最初の行 12firstrow = 3 13 14Dim defrow As Integer '1行当たりのデータ数 15defrow = 100 16 17Dim lngrow As Long 'データ整理シートのデータ貼りつけセル変数 18Dim dataarray() As Variant 'データ仮格納配列 19Dim rdataarray() As Variant 'データを反転させた配列 20Dim array1d As Variant '反転データから1行分を抽出した1次元配列 21 22'配列の再定義 23ReDim dataarray(1 To endrow, 1 To 100) 24ReDim rdataarray(1 To endrow, 1 To 100) 25 26Worksheets("元データ").Select 27dataarray = Range(Cells(startrow, 5), Cells(endrow, 104)) 28 29'1行ごとに、データの向きを入れ替え 30For i = 1 To endrow - startrow + 1 31 For j = 1 To 100 32 rdataarray(i, j) = dataarray(i, 100 - j + 1) 33 Next j 34Next i 35 36'「データ整理」シートに貼り付け 37For r = 5 To endrow 38 lngrow = firstrow + defrow * (r - 5) 39 40 Worksheets("元データ").Cells(r, 4).Copy Worksheets("データ整理").Cells(lngrow, 1) 41 array1d = WorksheetFunction.Index(rdataarray, r - 4) 42 43 Worksheets("データ整理").Select 44 Range(Cells(lngrow, 2), Cells(lngrow + 99, 2)).Value = WorksheetFunction.Transpose(array1d) 45Next r 46 47Application.ScreenUpdating = True 48End Sub 49

試したこと

おそらく、「データ整理シートに貼り付ける」ところが時間がかかっていると思われますが、
どう改善したらいいのかわかっていません。
よろしくお願いいたします。

補足情報(FW/ツールのバージョンなど)

Excel 2016

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答2

0

たとえばこんな感じでどうでしょうか。

VBA

1 2Sub Sample() 3 Dim rng As Range, arr As Variant 4 Set rng = Worksheets("元データ").UsedRange 5 arr = rng.Value 6 7 Dim maxRow, maxCol 8 maxRow = UBound(arr, 1) 9 maxCol = UBound(arr, 2) 10 11 Dim rng2 As Range, arr2 As Variant 12 Set rng2 = Worksheets("データ整理").Range("A3").Resize(maxRow * (maxCol - 1), 2) 13 arr2 = rng2.Value 14 15 Dim i, j, r 16 For i = 1 To maxRow 17 arr2(r + 1, 1) = arr(i, 1) 18 For j = maxCol To 2 Step -1 19 r = r + 1 20 arr2(r, 2) = arr(i, j) 21 Next 22 Next 23 rng2.Value = arr2 24 25End Sub

投稿2021/04/01 13:35

jinoji

総合スコア4585

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

Hiroms

2021/04/02 00:40

ご提案ありがとうございます!試して見ましたが、こちらも一瞬で完了させることができました。データ歯抜けなどがあったので少し微修正が必要ですが、考え方参考にさせていただきます!
guest

0

ベストアンサー

大量のデータの転記処理の場合、なるべくRangeへのアクセスは減らすという方向で処理を考えるといいでしょう。

そこで、データ範囲のRangeを配列に格納。
出力のセル範囲と同じサイズの配列を用意しておいて、上記の配列から転記する。
出力用配列を出力のセル範囲に出力。
とすると、Rangeへのアクセスは2回ですみます。

コード例

vba

1Sub Macro1() 2 Application.ScreenUpdating = False 3 4 Dim startrow As Long 'データの最初の行 5 startrow = 5 6 Dim endrow As Long 'データの最後の行 7 endrow = 1007 8 Dim firstrow As Long 'データ整理シートの最初の行 9 firstrow = 3 10 11 Dim InRowCnt As Long 'データの行数 12 InRowCnt = endrow - startrow + 1 13 14 Dim defrow As Long '1行当たりのデータ数 15 defrow = 100 16 17 Dim InAry() As Variant '元データ格納配列 18 With Worksheets("元データ") 19 InAry = .Range(.Cells(startrow, 4), .Cells(endrow, 104)).Value 20 End With 21 22 Dim OutAry() As Variant 'データ整理格納配列 23 ReDim OutAry(1 To InRowCnt * defrow, 1 To 2) 24 25 26 Dim r As Long, c As Long, n As Long 27 For r = 1 To InRowCnt 28 OutAry(r * defrow - 99, 1) = InAry(r, 1) 29 For c = defrow + 1 To 2 Step -1 30 n = n + 1 31 OutAry(n, 2) = InAry(r, c) 32 Next 33 Next 34 35 Worksheets("データ整理").Cells(firstrow, 1).Resize(InRowCnt * defrow, 2).Value = OutAry 36 37 38 Application.ScreenUpdating = True 39End Sub

投稿2021/04/01 13:35

編集2021/04/01 13:38
hatena19

総合スコア33620

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

Hiroms

2021/04/02 00:37

ありがとうございます。ご提案頂いたもので一瞬で完了できました。(一部の変数だけ微修正させていただきました。)
Hiroms

2021/04/02 00:41

「なるべくRangeへのアクセスは減らすという方向」 勉強になりました。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問