エクセル VBA 処理スピードを上げたいのですが。

エクセルで、40000行のデータ（氏名や住所など40項目のデータ）を元データシートとし、コードをもとにコード名のシートに振り分け、振り分けが済んだら元データに色を付ける処理を行います。
コードは、変動（毎月増える）がありますが、280件ほどで、シートも280シートをあらかじめ作っています。
以下のコードで実行するのですが、オートフィルタを使っているためか、処理に30分ほどかかってしまいます。5分か、長くても10分で終わらせたいのですが、コードを編集することで劇的にスピードアッ
プできたらうれしいのですが、どなたかど指南いただけないでしょうか。
主なシート
全コートが書かれているシート（1）
元データがあるシート（1）
それぞれのコードのシート（280）

Sub コマンドボタンCMdata1_Click()
Dim nums As Variant
With UserForm1
.Show vbModeless
.Repaint
End With
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
nums = Array("001")
Call CopyToTarget("001", nums)
　　　　　　||
　　　　この間に、全コードがある
　　　　　　||　
nums = Array("280")
Call CopyToTarget("280", nums)
Unload UserForm1
MsgBox "データをコピーしました。"
Sheets("手順シート").Select
　Application.ScreenUpdating = True
　Application.Calculation = xlCalculationAutomatic
End Sub

Sub CopyToTarget(nameTargetSheet As String, numbers As Variant)
Dim My_Target As Range
Dim SelectedArea As Range
Set My_Target = Worksheets(nameTargetSheet).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
With Worksheets("元データ")
.AutoFilterMode = False
.Range("A1").AutoFilter _
Field:=4, _
Criteria1:=numbers, _
Operator:=xlFilterValues
.Sort.SortFields.Clear
.Sort.SortFields.Add _
Key:=.Range("D2"), _
SortOn:=xlSortOnValues, _
Order:=xlAscending
.Sort.SetRange .Range("A1").CurrentRegion
.Sort.Header = xlYes
.Sort.Apply
Set SelectedArea = .Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
SelectedArea.Copy My_Target
My_Target.Resize(1, 66).Delete Shift:=xlUp
SelectedArea.Interior.Color = RGB(255, 255, 0)
.AutoFilterMode = False
End With
End Sub

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

• ご丁寧な回答をありがとうございます。
  説明不足で申し訳ありません。
  これは、請求書発行を行うものです。今の処理は、元データを顧客コードをもとに顧客コードシートにデータを振り分け、鑑と明細を印刷するものです。データを振り分けるのは、明細書を作るためです。ただ、事情により1つの顧客で複数のコードを持っているものもあります。1顧客コードシートに複数コードのデータをコピーしなければなりません。
  なので、
  nums = Array("31", "311", "312", "313")
  Call CopyToTarget("031", nums)
  として、複数コードを配列として呼び出しております。
  請求書は、下準備（シートを準備する）をして上で、印刷実行していますが、印刷時に元データより明細書シートにデータをコピーしながら、印刷するでもよいです。これで、ご理解いただけますでしょうか。

  No.4の回答に寄せられた補足コメントです。 補足日時：2023/04/05 22:11

No.6 回答者： fujillin 回答日時： 2023/04/05 22:38

No4です。

＞これで、ご理解いただけますでしょうか。
ほとんどわかりませんけれど、どうやら1対1ではなく複数のコードを一つのシートにまとめるということらしいと解釈しました。

もしそうであるなら、先にシートごとに振り分けるコードのテーブルを作成しておいて、振り分ける時にそちらを参照してシートを決める様にすれば良いだけと思います。
コード上で作成しても良いですし、どこかのシートに表を作成しておいても良いでしょう。

テーブルを参照する分だけ処理時間はかかりますが、メモリ上での検索ですし、高々300種類程度のコードのようなので、処理時間としては変わらないと考えても良さそうに思います。

元の表を並べ替えても良いのなら、No4のコードの考え方のままで、転記先のシートの決める部分だけ修正すれば処理できるでしょう。
元の表を並べ替えたくない場合は、最初に元データのシートのコピーを作成して、そちらで並べ替えを行い、処理が終わったらそのシートを削除するようにしておけば、同様のロジックのままで処理ができると思います。
こちらも、ほぼ同じ時間で処理ができるものと想像します。
（シートのコピーと削除の処理時間だけ増加しますけれど・・）

No.5 回答者： ママチャリ 回答日時： 2023/04/01 15:25

実際にテストした訳ではないので、どれほどの効果があるか分からないのですが、AutoFilter をやめて、AdvancedFilter にしてみては、いかがでしょう？

AdvancedFilter には、「フィルター処理したデータを新しい場所にコピーする」って機能があります。
AutoFilter のように、「フィルタして、コピーして、ペーストして、フィルタ解除」のようなステップを諸略して、いきなり「新しい場所にコピー」してくれるので、高速化が期待できるような気がします。

No.4 回答者： fujillin 回答日時： 2023/04/01 11:01

No3です。

コードしかないので、なさりたいことが正確にはわかりかねますが、勝手な解釈で作成してみました。
方法は、No3の回答に記した通りの方法です。
　・元データは並べ替えても良いものとする
　・D列の値に対応するシートが必ず存在する（用意されている）
　・データおよび転記先の1行目はタイトル行となっている
という前提でのコードです。

当方の環境では、No3のテストデータ（40000行）で、1秒程度で終了します。
（全部メモリ上で処理すれば、もう少し速くなる可能性はあるかも）
※ 転記は「値の転記」にしてあります。（コピーにはしていません）
※ 色付けに関しては、意味が不明なので省略しています。
※ ScreenUpdatingなどの速度アップのため処置は省略してあります。

推測半分で作成していますので、必ず「コピーブック」などでテストしてください。

以下、ご参考までに。

Sub Q_13412599()
Dim shs As Worksheet, dsh As Worksheet
Dim sRange As Range, v, tmpNo
Dim mCol As Long, mRow As Long
Dim r As Long, tmpr As Long, dRange As Range

Set shs = Worksheets("元データ")
Set sRange = shs.Range("A1").CurrentRegion
mCol = sRange.Columns.Count
mRow = sRange.Rows.Count
sRange.Sort sRange(4), xlAscending, Header:=xlYes
v = sRange.Columns(4).Offset(1).Value

r = 1
While v(r, 1) <> ""
tmpNo = v(r, 1)
tmpr = r
While v(r, 1) = tmpNo
r = r + 1
Wend
Set dsh = Worksheets(CStr(tmpNo))
Set dRange = dsh.Cells(Rows.Count, 1).End(xlUp).Offset(1)
dRange.Resize(r - tmpr, mCol).Value = sRange(tmpr + 1, 1).Resize(r - tmpr, mCol).Value
Wend
End Sub

No.3 回答者： fujillin 回答日時： 2023/03/31 23:47

こんばんは

当方の環境だと概ね40000行で40秒ほどなので、比較はしにくいのですが・・
既回答にあるように、速度アップするにはメモリ上で処理を行う方が速くなります。
ただし、列数もある程度あるようなので、メモリの使用量は増加します。
ご提示のコードのままでも、Sortメソッドには意味が無いように見えるので、それを外してみたところ処理時間は半分以下になりました。（40秒 → 15秒）

実際のデータ構成が不明ですけれど・・
・D列の値に対応するシートは必ず存在する
・元データを並べ替えてもかまわない
のであるなら、並べ替えだけはシート機能を利用して先に並べ替え
その上で、
D列だけをメモリに読み込んで、（メモリ上で）同じ値が連続する範囲を探して、その範囲に関してコピペすることを繰り返すようにすれば、かなり早くなるものと想像します。
試してはいませんけれど、1列だけの読み込みで済むので、メモリの使用量もさほど増加はしません。

色付けに関しては、処理が終われば全部のデータに色が着くだけではないかと思いますけれど、本当に必要な処理なのでしょうか？
マクロを実行したか否かが目視できるようにしたいのであれば、どこかのセルに「実行済」などの表示をするとか、タイトル行だけに色を付けるなどでも充分ではないかと思いますけれど・・

No.2 回答者： mabuterol 回答日時： 2023/03/31 21:31

空の配列を用意しておいて、そこにエクセルのシートのセル範囲を示すオブジェクトを渡してあげれば、配列の中に高速に中身が格納できます。

この記事のような方法を参考にしてみて下さい。
http://officetanaka.net/excel/vba/speed/s11.htm

VBA を高速に動かす一番のコツは、オブジェクトを用いてデータをやり取りする事です。C 言語で言えばポインタを使うみたいなもんでしょうか。

配列の中に中身を格納してしまえば、フィルタを使う代わりに、if 文とかを使いながら条件判定していけば良いです。

この回答へのお礼

参考になりました。
ありがとうございました。

お礼日時：2023/04/09 09:09

No.1 回答者： zongai 回答日時： 2023/03/31 21:24

ChatGPTで、

現状のコードの末尾に「高速化したい」とコメントをつけて問うと、
ちょっと手が加えられたコードは出てきましたが、
実際の動作まで分析できないのでココに上げません。すみません。

気になるようでしたら、ChatGPTも試してみて下さい。
動作しないもんを吐き出すこともあるけどね。

この回答へのお礼

ご回答ありがとうございます。
今話題のChatGPTですね。
試してみたいと思います。

お礼日時：2023/04/05 22:13