[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『作業時間短縮出来ないでしょうか。』(ライチ)
下記の通りマクロ作成したのですが
行数が5000行近くあるエクセルで
処理が終了するのに半日かかったりしてしまいます。
内容としては
A列にある行数を確認し
ED1からNH1まで関数が入っているので
それをコピーしED4から
A列で確認した行数の最後まで
ED1からNH1をコピー⇒貼付け⇒貼付けたのをコピー⇒値で貼付け
これの繰り返しです。
時間短縮するにはどうすればいいかお知恵を拝借出来ないでしょうか。
Sub 春夏用()
'
' 春夏用
'
'Sheet1のシート選択
Sheets("Sheet1").Select
'mycntでA列の4行目から最終行の行数を指定
Dim myCnt As Long
For myCnt = 4 To Cells(4, 1).End(xlDown).Row
'ED1からNH1までコピー元を指定
Range("ED1:NH1").Select Selection.Copy
'ED4から最終行までの作業を指定
Cells(myCnt, 134).Select ActiveSheet.Paste Selection.Copy On Error Resume Next Selection.PasteSpecial Paste:=xlPasteValues Next myCnt
'上書き保存
ActiveWorkbook.Save
'
End Sub
< 使用 Excel:Excel2016、使用 OS:Windows10 >
これ一気にコピペして定数化できない理由があるのでしょうか? 上から順に定数化しないと計算が崩れるとか。
(白茶) 2022/06/29(水) 13:19
VBAのことはあまりわかりませんが 結局値で貼り付けるならコピペではなく転記した方が早いのではないでしょうか 間違っていたらすみません(VBAは書けませんので) (なるへそ) 2022/06/29(水) 13:20
Sub 春夏用() ' ' 春夏用 Dim myCnt As Long ' ' Sheet1のシート選択 With Sheets("Sheet1") ' mycntでA列の最終行の行数を求める myCnt = .Cells(4, 1).End(xlDown).Row ' ED1からNH1までをED4セルからNHの最終行までに貼り付ける .Range("ED1:NH1").Copy .Range(.Cells(4, "ED"), .Cells(myCnt, "NH")) ' 上記範囲をコピー .Range(.Cells(4, "ED"), .Cells(myCnt, "NH")).Copy ' 上記範囲を値貼り付け .Range(.Cells(4, "ED"), .Cells(myCnt, "NH")).PasteSpecial Paste:=xlPasteValues End With ' 上書き保存 ActiveWorkbook.Save ' End Sub ではどうだろうか? (ねむねむ) 2022/06/29(水) 13:23
おっと、一応書き方を統一するということで。(変更せずとも問題はない) >myCnt = .Cells(4, 1).End(xlDown).Row を myCnt = .Cells(4, "A").End(xlDown).Row としてくれ。 (ねむねむ) 2022/06/29(水) 13:31
Sub 春夏用() の下に
Application.Calculation = xlCalculationManual
を入れて、
End Sub の上に
Application.Calculation = xlCalculationAutomatic
を入れる。
おそらくこんなことなんじゃないのかな?
(通りすがり) 2022/06/29(水) 13:36
こんなので良さそうですけどね。(ろくにテストはしておりませんが)
Sub 春夏用() Dim myCnt As Long
'Sheet1のシート選択 Sheets("Sheet1").Select
Range("ED1:NH1").Copy
With Cells(4, 134).Resize(Cells(4, 1).End(xlDown).Row - 3, 239) .PasteSpecial xlPasteAll .Value = .Value End With
'上書き保存 ActiveWorkbook.Save
End Sub
(半平太) 2022/06/29(水) 13:38
>ED1からNH1まで関数が入っているので
諸回答案で旨く行かないなら、その関数に問題があるかも知れません。 (非効率の権化みたいな数式かも知れない)
その時は、その数式をアップしてください。より適切に判断できます。
(半平太) 2022/06/29(水) 13:54
白茶様
なるへそ様
VBA使わずに手作業でとのことでしたが
実際に試してみたところ
コピーして貼付けして値で貼付けをし直すと
5000行×ED〜NH(379)=18950000
18950000セルだとやはり同じように時間がかかる上に
どこまで貼付け作業が終わったかわかりにくいというのもあります。
ねむねむ様
通りすがり様
半平太様
助言ありがとうございます。
早速試してみたいと思います。
(ライチ) 2022/06/29(水) 14:31
>VBA使わずに手作業でとのことでしたが 誰かそんな事言いましたっけ...?
(白茶) 2022/06/29(水) 14:37
Selectすると遅いかもですね?
Selectすることで遅くなる理由は、画面描画やイベント処理に時間が掛かっていることと、 ActiveCellオブジェクトなどの選択セルの状態の書き換えに時間が掛かることが原因と思われます
「 Select 遅い 原因 VBA 」で検索したら上記の文章が出てきました。
推定ですが、ねむねむさんのマクロコードの書き方が 処理スピードとしては速いと思われます。
因みに、簡単な式を「 ED1〜HN1 」に入れてテストしたところ
■A列は5000行で検証
(ライチ)さんのマクロでは、画面が揺れすぎて1分たっても 処理が終わらないのでタスク終了(強制終了)
ライチ)さんのマクロで、A列を100行で検証 これなら処理が終わり
計測時間は、3回して
9.6259.875 9.57421875 9.62890625
(ねむねむ)さんのマクロで、A列を5000行で検証
3.40625 3.453125 3.5
画面の揺れもなく、処理がスムーズでした。 尚、A列を100行なら2回しかしてませんが
0.390625 0.40625
でした。さらに高速化する為に
(通りすがり)さんのおっしゃる
↓これいれて検証 Application.Calculation = xlCalculationManual Application.Calculation = xlCalculationAutomatic
(ねむねむ)さんのマクロで、A列を5000行で検証
2.97265625 3.078125 3.16015625
さらに速くなりました。
使用した、マクロをいちよ〜UP
Option Explicit Dim StartTime As Double, EndTime As Double, processTime As Double
Sub 春夏用() '' ねむねむs流 Dim myCnt As Long StartTime = Timer Application.Calculation = xlCalculationManual With Sheets("Sheet1") myCnt = .Cells(4, "A").End(xlDown).Row .Range("ED1:NH1").Copy .Range(.Cells(4, "ED"), .Cells(myCnt, "NH")) .Range(.Cells(4, "ED"), .Cells(myCnt, "NH")).Copy .Range(.Cells(4, "ED"), .Cells(myCnt, "NH")).PasteSpecial Paste:=xlPasteValues End With ActiveWorkbook.Save Application.Calculation = xlCalculationAutomatic EndTime = Timer processTime = EndTime - StartTime Debug.Print processTime End Sub
もっと高速化する書き方は私にはわかりませんが あとは、式の問題もあると思います。
(あみな) 2022/06/29(水) 15:46
■1
提示されたコードを整理すると↓のようになりますよね。
Sub 春夏用_整理1() Dim myCnt As Long
With Sheets("Sheet1") For myCnt = 4 To .Range("A4").End(xlDown).Row .Range("ED1:NH1").Copy .Cells(myCnt, 134) .Cells(myCnt, 134).Resize(, 234).Copy .Cells(myCnt, 134).Resize(, 234).PasteSpecial Paste:=xlPasteValues Next myCnt End With
ActiveWorkbook.Save End Sub
■2
つまり、上記では4〜Range("A4").End(xlDown).Row行目までを1行ずつ処理しているわけですが、この処理であればまとめて処理しても結果は変わりません。
すなわち↓のようにすれば、同じ処理を行数分繰り返して時間が掛かるということは避けられます。
Sub さんぷる() Dim myCnt As Long
myCnt = Sheets("Sheet1").Range("A4").End(xlDown).Row
With Sheets("Sheet1").Range("ED4:NH" & myCnt) .Rows(1).Offset(-3).Copy .Cells .Value = .Value End With
ActiveWorkbook.Save End Sub
■3
>行数が5000行近くあるエクセルで処理が終了するのに半日かかったりしてしまいます。
少々気になるのが、↓の部分です
Cells(4, 1).End(xlDown).Row
「A列にある行数を確認し」と仰っているのでたぶん大丈夫だとは思いますが、A列の状況によっては最大行が返ってきますよね。
なので、4〜5000行だとおもっていたら、実際には4〜1048576行目までの処理になっていたなんてオチはないでしょうか?
■4
VBAの世界では基本的にシートやセル(オブジェクトと言います)は、きちんと明示すればいちいちアクティブにしたり選択したりする必要はありません。
逆に言うと、いちいちアクティブにしたり選択したりするのは無駄です。
なので、実行処理が気になるのであれば、まずはこのような無駄処理が無いか確認すると良いでしょう。
そして、上記でも書いたように、同じような処理を何回も繰り返せばその分時間が掛かるわけですから、まとめて出来ることは一括で処理できないかを考えてみるとよいでしょう。
※それでもなお時間がかかるというのであれば、すでに指摘があるように数式の再計算に時間がかかっているんでしょうね。たぶん。
(もこな2 ) 2022/06/29(水) 15:51
あみなさん、検証ありがとう。 ただ、式がセル参照を含んでいて式を張り付けた際に行ごとにセル参照が変わっていく場合(私はこのパターンだと判断した)、 コピー・値貼り付けの前に計算方法を自動に戻さないと全行同じ値になってしまう。 (ねむねむ) 2022/06/29(水) 15:58
白茶様
返答ミス申し訳ございません。
あみな様
検証いただきありがとうございます。
もこな2様
ご助言ありがとうございます。
VBAについてまだまだ初心者でご対応いただき助かります。
ED1〜NH1まで入っている関数は
LEFT関数やVLOOKUP関数がほぼ占めております。
ひとつひとつ作業を行っているのですが
ねむねむ様のは今実行中で結果待ち状態です。
通りすがり様のを実行したところ
関数が反映されなかったのですが、原因がわからない状態です。
半平太さまのを実行したところ
ほぼほぼ問題ないのですが00が0になったり09が9になったりという箇所があり
これも原因不明の状態です。
あみな様ともこな2様のマクロについてはねむねむ様の結果後に順次確認したいとおもいます。
皆様本当にありがとうございます。
(ライチ) 2022/06/30(木) 11:33
>半平太さまのを実行したところ >ほぼほぼ問題ないのですが00が0になったり09が9になったりという箇所があり >これも原因不明の状態です。
Valueを入力したため、数字(文字型)→数値に変換されたのが原因です。
ならば、これでいいでしょう。 何秒くらい掛かりますか? ↓ Sub 春夏用()
'Sheet1のシート選択 Sheets("Sheet1").Select
Range("ED1:NH1").Copy
With Cells(4, 134).Resize(Cells(4, 1).End(xlDown).Row - 3, 239) .PasteSpecial Paste:=xlPasteAll .Copy .PasteSpecial Paste:=xlPasteValuesAndNumberFormats .Cells(1, 1).Select End With
Application.CutCopyMode = False
'上書き保存 ActiveWorkbook.Save End Sub
(半平太) 2022/06/30(木) 18:49
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.