[[20220629121553]] 『作業時間短縮出来ないでしょうか。』(ライチ) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『作業時間短縮出来ないでしょうか。』(ライチ)

下記の通りマクロ作成したのですが
行数が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.