Excel2013vba高速化(行の高さコピー)

お世話になります。

現在作っているコードがあるのですが、だいぶ処理時間がかかるのでもう少し早くしたいのですが何かいい案がないかお知恵を貸していただければと思っています。

色々処理をしているのですが、下記の提示箇所でほとんどの時間をくっていることが分かりました。
そのなかでもほとんどが行の高さをコピーして貼り付けていく所です。(Set myNewRng~Next m)
ある環境では、この処理で早くて１ループ６秒程度かかっています。10ループあれば１分かかってしまいます。

下記のコードはまず、貼り付け先に該当する場所が、原紙1でなければAllAddress(1)表をコピーして貼り付けています。
その後、行高さをコピーして貼り付けています。(列幅はこの前の段階でコピー貼り付け実行済み）
行高さ貼り付けは、myNewRngに高さ貼り付け先開始セルをセットし、mには、AllAddress(1)表の開始行と最後行をセットしておき、貼り付け元と貼り付け先を1行毎増やしながら行高さをコピーしていくやり方です。
表の行数や行高さなどは可変する可能性があります。
あとは、別シートから何個か必要なものを貼り付けています。
それを、i回繰り返し。
よろしくお願いいたします。

For i = LBound(mydicKey) To (UBound(mydicKey)) - 1
'1人毎コピーして貼り付け
If Not ws.Cells(StaRow(1) + (AllRow + AllRow * i), EndCol(2) + 2).Value = "原紙1" Then
ws.Range(AllAddress(1)).Copy ws.Cells((AllRow) * (i + 1) + 1, StaCol)

'行高さをコピー貼り付け('AllAddress(1)の開始セルからm行目までの行高さを順番にコピーし、
　　　　'myNewRngセルから下に向かって行高さを貼り付け変更していく)
Set myNewRng = ws.Cells((AllRow) * (i + 1) + 1, StaCol)
For m = StaRow(1) To EndRow(2)
myNewRng.Rows(m).RowHeight = ws.Range(AllAddress(1)).Rows(m).RowHeight
Next m

ws.Cells(StaRow(1) + (AllRow + AllRow * i), EndCol(2) + 2).Value = _
　　　　　　 .Cells(12 + 1 + i, 2).Value
ws.Cells(1 + StaRow(1) + (AllRow + AllRow * i), EndCol(2) + 2).Value = _
　　　　　　 .Cells(12 + 1 + i, 4).Value
ws.Cells(worker_nameRow(1) + (AllRow * (i + 1)), worker_nameCol(1)).Value = _
　　　　　　 .Cells(12 + i + 1, 3).Value
ws.Cells(Range(ContactInfo(1)).Row + (AllRow * (i + 1)), Range(ContactInfo(1)).Column) = _
　　　　　　 .Cells(12 + 1 + i, 6).Value
End If
Next i

質問者からの補足コメント

• ありがとうございます。
  表なのですが、この度作成したものは自分で好きな表を作成して扱えるように作りました。よって、表は様々であり固定ではありません。（実際は固定して使うと思いますが途中で変更しても問題ないようにしています）
  コピペ時の書式貼り付けですが、列幅は出来ると思いますが行高さをコピーすることは出来るのでしょうか？行全体をコピーした場合であればそのまま行高さをコピーできると思いますが、現在行っているものは、印刷時左右２つの表を印刷する作りにも対応させ、さらに条件で左の表や右の表だけ印刷などにも対応させる為に行全体のコピーではなく表毎のコピーにしています。
  
  表全体を選択してコピー貼り付けする時に行高さも貼り付けることが可能であればありがたいですが、出来ますか？その操作が可能であれば他への影響はありません。

  No.1の回答に寄せられた補足コメントです。 補足日時：2020/05/04 10:26

• 説明が悪かったのですが、並んだ表は当然同じ行高さです。
  行コピーで貼り付けていない理由を説明したかったのですが、例えば条件によって同じ行に並んでいる右の表だけ必要で左表はコピーしたくない場合もある為、行コピーは行っておらず表毎のコピーを実施しています、ということが言いたかったのですが、意味分かりますか？
  表の行毎の高さは様々ですし、固定もされません。
  
  ちなみに、さらに言うと左右に並んだ表というパターンの他、上下２つの表を別のものとして並べるパターンもあります。基本的には、同じパターンで作成すると想定されますが、行高さは上下で違うものでも大丈夫にしたくて1行処理を行った結果、かなり時間を食う事が発覚してしまいました。上下２つや左右２つの表は、当然分岐処理で分けるべきところは分けて処理しています。
  
  セル範囲のコピーなので当然行高さはコピーされないので、何とかならないかな、と思っています。

  No.2の回答に寄せられた補足コメントです。 補足日時：2020/05/04 14:06

• その辺りは、実施しております。イベント停止や再計算停止とかも。

  No.3の回答に寄せられた補足コメントです。 補足日時：2020/05/04 15:00

• myNewRngは単セルではありますが、起点セルとして使っています。
  例えばA1:O31範囲の表があるとして、
  AllRow = Range(lastAddress(1)).Rowで31ですね。A1:O31表を計算して下方向へずらしながら貼り付けていくイメージです。ｍは表の開始行と終わり行です。
  右辺のws.Range(AllAddress(1)).Rows(m).RowHeightが元表の開始行から終わり行までを順に巡ります。左辺では、起点セルmyNewRngから行位置を取得しています。
  と思ってやっていましたが、.Offset(m).Rowsでも動作しました。ぱっと見はこっちの方が分かりやすいですね。時間は特に変化なしです。
  Rowsというのはこういう使い方ありでは？
  For i = 1 To 10
  Range("A1").Rows(i) = 30
  Next i
  A1:A10に30入力

  No.6の回答に寄せられた補足コメントです。 補足日時：2020/05/04 20:30

• 自分でもう少し工夫しました。
  できるところは、行丸ごとコピーに変更し1行毎の高さコピーを減らしました。
  また、1行毎に行高さをコピーしないといけない所では、動的配列rowNumに入れてやると13秒→9秒位に短縮できました。文字数制限で端折ります。まだ、遅いですが少しましに。
  For m = ××
  rowNum(m - 1) = ws.Range(AllAddress(1)).Rows(m).RowHeight
  Next m
  
  Set myNewRng = ××
  For m = LBound(rowNum) To UBound(rowNum)
  myNewRng.Rows(m + 1).RowHeight = rowNum(m)
  Next m
  
  ws.Range(AllAddress(1)).Copy myNewRng

    補足日時：2020/05/04 20:37

• 時間がかかる処理なのかなと思いこんでいましたが、新しいので、適当に同じくらいの行を処理したのですが、同じようなやり方でもあっという間に終わりました。
  Selectしながら行の貼り付け元と貼り付け先の動きを確認しましたが、予期せぬ所をつかんでいるようなことはなかったです。
  
  あきらめて、行丸ごとコピー方式に変更しました。
  速くはないけど厳しそうな条件で動かして、飛び飛びの複雑な改ページ設定などもして印刷ダイアログ開くまでもっていくのに23秒だったのでまあ使えるレベルになったかなと思います。(最初は2分近くかかっていたと思う)
  デバック中に何度もクラッシュ起こしているので、完全に他の部分も終わったら、新規ブックに移設して使いたいと思います。
  お付き合いいただきありがとうございました。

  No.7の回答に寄せられた補足コメントです。 補足日時：2020/05/04 23:23

No.7 回答者： Qchan1962 回答日時： 2020/05/04 21:36

>Rowsというのはこういう使い方ありでは？

そうですね、勘違いしていました意味のない回答でした。すみません。しかし、処理時間がそんなにかかるのは、不思議です。

＃５に回答する時に書こうか迷ったのですが、別シートに転記していないのですね。
少し乱暴かも知れませんが、別シートに全コピーして不要部分をDeleteした方が
纏め処理できるので処理時間早いかもですね。

この回答へのお礼

ありがとうございました。
とりあえず納得できる速度になったので、これは終わりたいと思います。

お礼日時：2020/05/04 23:25

No.6 回答者： Qchan1962 回答日時： 2020/05/04 19:44

AllAddress(1)の範囲がいまいちわかりませんが、

Set myNewRng = ws.Cells((AllRow) * (i + 1) + 1, StaCol)
For m = StaRow(1) To EndRow(2)
myNewRng.Rows(m).RowHeight = ws.Range(AllAddress(1)).Rows(m).RowHeight
Next m

myNewRngは単セルで良いですか？
であれば、
For m = StaRow(1) To EndRow(2)
myNewRng.Rows(m).RowHeigh　の意味はどうなりますか？
myNewRngもAllAddress(1)も共にm番目のRowを持っていると思いますが、、
AllAddress(1)はAllRow飛ばしのコピーを行っているので範囲があると思います。

Set myNewRng = ws.Cells((AllRow) * (i + 1) + 1, StaCol)は単セルを示しています。

もしFor mの為に範囲を持たせるのであれば、書き直す必要があると思いますが、推測するに

For m = StaRow(1) To EndRow(2)
myNewRng.Offset(m).Rows.RowHeight = ws.Range(AllAddress(1)).Rows(m).RowHeight
Next m

変数の代入方法など不明の為、該当しないかも知れませんが、、

No.5 回答者： Qchan1962 回答日時： 2020/05/04 15:40

横から失礼します。

処理速度が遅いのは、再計算停止をしても書式設定による表示処理が行われるのが原因だと思います。
（折り返しや縮小など）

なので、先にコピー先シートの列幅、行高さを設定りてから、対象にコピペすれば良いのではないでしょうか？
内容はよくわかりませんので未検証ですが、処理の順番を変えてみるのはいかがでしょう。

If Not ws.Cells(StaRow(1) + (AllRow + AllRow * i), EndCol(2) + 2).Value = "原紙1" Then
Set myNewRng = ws.Cells((AllRow) * (i + 1) + 1, StaCol)
For m = StaRow(1) To EndRow(2)
myNewRng.Rows(m).RowHeight = ws.Range(AllAddress(1)).Rows(m).RowHeight
Next m
ws.Range(AllAddress(1)).Copy ws.Cells((AllRow) * (i + 1) + 1, StaCol)


他のセルへの書き出しは、出来るなら配列などに纏め一度に書き込んだ方が処理は早いと思います。

的違いなら忘れてください。

この回答へのお礼

ありがとうございます。
実測では速くはなりませんでしたが、ws.Range(AllAddress(1)).Copy　myNewRng 　とシンプルに記載できることに気が付きました。

お礼日時：2020/05/04 17:06

No.4 回答者： めぐみん_ 回答日時： 2020/05/04 15:04

No.2です。

印刷の為の表であれば罫線など使用されていると思われますね。
値を省いても書式をペーストすれば罫線だけが貼りつく状態なので、初級レベルで言うなら現在やられている方法（１行ずつ合わせる）しかなさそうです。
表の固定化が困難であるなら避けられないのではないかと。

https://www.relief.jp/docs/excel-macro-copy-row- …

この回答へのお礼

ありがとうございました。

お礼日時：2020/05/04 23:25

No.3 回答者： ママチャリ 回答日時： 2020/05/04 14:54

いろいろ、ご事情があるのですよね？であれば・・・・。

マクロの最初に・・・、
Application.ScreenUpdating = False

最後に・・・、
Application.ScreenUpdating = True

これだけでも、そこそこ早くなります。

この回答へのお礼

ありがとうございました。

お礼日時：2020/05/04 23:26

No.2 回答者： めぐみん_ 回答日時： 2020/05/04 13:38

No.1です。

なんか思い浮かべられないのですが。
２つの表が左右で並んでいるとして、『とある列間では行の高さを広げ、その横では同じ行の高さを下げる』なんてExcelの仕様上無理なのでは？
なので２行を結合して広く『見せる』などの手段は用いた事ありますけど。

既に作成されている表では１行の高さを列の途中で列の高さを変更するなんて出来ているのでしょうか？（ちょっと前まで2002を弄ってたので機能の変化には追い付けてません）

No.1 回答者： めぐみん_ 回答日時： 2020/05/04 06:57

どのような表？なのか全くわかりませんけど、コピペで『書式』選択で行うと他の部分で影響が出るのでしょうか？