名簿を分割保存するマクロを高速化したいです

投稿者 : フウ     投稿日時 : 2024/07/31(Wed) 21:58:59     OS : Windows 10     EXCEL : Excel 2021

---

はじめまして。
名簿を所属ごとに分割する作業が手間で、ネットで調べたコードを切り貼りして、以下のとおり、基準列をベースに名簿を分割するマクロを作りました。
ただ件数が多いと非常に時間がかかるため、高速化したいです。
※ネットで名簿分割の既成マクロが配られてますが、フォントサイズ、セルの幅、名簿によっては1行目が結合されてるなどで、もとの様式のまま分割できるものを見つけられませんでした。

Sub データ分割()

Application.ScreenUpdating = False

ChDir ThisWorkbook.Path

'基準列とは…A列＝１、B列＝２・・・、分割グループを設定した列を指定すること
基準列 = 10
開始行 = 4
最終行 = ActiveSheet.UsedRange.Cells(ActiveSheet.UsedRange.Count).Row

'警告メッセージを表示しない
    Application.DisplayAlerts = False


For i = 最終行 To 開始行 Step -1

'ファイル名の頭に基準列をつけます
ファイル名 = Cells(i, 基準列).Value & "（○○名簿）"

If Dir(ファイル名) = "" Then

ActiveSheet.Copy
ターゲット = Cells(i, 基準列).Value

For d = 最終行 To 開始行 Step -1
If Cells(d, 基準列).Value <> ターゲット Then Rows(d).Delete
Next d

    ' スクロール列の設定
    ActiveWindow.ScrollColumn = 1
    ' スクロール行の設定
    ActiveWindow.ScrollRow = 1

ActiveWorkbook.SaveAs ファイル名
ActiveWorkbook.Close



End If

Next i



Application.ScreenUpdating = True

 '警告メッセージを表示
    Application.DisplayAlerts = True




End Sub

投稿者 : さんこう     投稿日時 : 2024/07/31(Wed) 22:43:05

---

＞高速化したいです

不要な行を削除する部分が遅いのでしょう。

参考になれば。

＜vba 条件に合わない行を削除 高速＞
https://www.google.com/search?q=vba+%E6%9D%A1%E4%BB%B6%E3%81%AB%E5%90%88%E3%82%8F%E3%81%AA%E3%81%84%E8%A1%8C%E3%82%92%E5%89%8A%E9%99%A4+%E9%AB%98%E9%80%9F

投稿者 : ピロリ     投稿日時 : 2024/08/02(Fri) 08:30:56

---

＞ ただ件数が多いと非常に時間がかかるため ･･･

ちなみに、10列目（ Cells(i, 基準列).Value ）には、どのような文字列が入っているのでしょう？
少なくとも、変数「ファイル名」にはファイル拡張子をセットしていないようなので、正当なファイルパスには
なってないと思います。　要は「C:\Users\ ・・・ \○○（○○名簿）.xlsx」のような文字列になってない･･･

結果、全行で　If Dir(ファイル名) = "" Then　が成立し、ファイル出力処理が動いてしまっているのでは？
多分「一度作ったファイルはもう作る必要はない」ってための判定文なのでしょうが、毎回「ファイル無いから
作らなきゃ」って動きになってると思いますが･･･

投稿者 : ピロリ     投稿日時 : 2024/08/02(Fri) 16:31:55

---

ChDir ThisWorkbook.Path　しているのですね。（見逃してました･･･）
ということは、10列目（ Cells(i, 基準列).Value ）には、所属部署名：「営業部」や「総務部」のような
文字列が入っているということですかね。　それならば、
ファイル名 = Cells(i, 基準列).Value & "（○○名簿）"　　　　 のところを、拡張子を付けて
ファイル名 = Cells(i, 基準列).Value & "（○○名簿）.xlsx"　　としたら、上手く動きませんか？

個人的には ChDir はせず（カレントは変えず）に、[返信 2]に記載したように ↓フルパスで処理した方が
良いと思いますけど･･･
ファイル名 = ThisWorkbook.Path & "\" & Cells(i, 基準列).Value & "（○○名簿）.xlsx"

投稿者 : ふう     投稿日時 : 2024/08/06(Tue) 12:24:38

---

Unionメソッドを使用することで解決できました！ありがとうございます！



■[返信 1] さんこうさん（2024-07-31 22:43:05）の記事
＞ ＞高速化したいです
＞
＞ 不要な行を削除する部分が遅いのでしょう。
＞
＞ 参考になれば。
＞
＞ ＜vba 条件に合わない行を削除 高速＞
＞ https://www.google.com/search?q=vba+%E6%9D%A1%E4%BB%B6%E3%81%AB%E5%90%88%E3%82%8F%E3%81%AA%E3%81%84%E8%A1%8C%E3%82%92%E5%89%8A%E9%99%A4+%E9%AB%98%E9%80%9F
＞

投稿者 : ふう     投稿日時 : 2024/08/06(Tue) 12:27:12

---

ピロリ様

フルパスに変更してみました！

よくわからないまま使っていたので、とても参考になりました！ありがとうございます！



■[返信 3] ピロリさん（2024-08-02 16:31:55）の記事
＞ ChDir ThisWorkbook.Path　しているのですね。（見逃してました･･･）
＞ ということは、10列目（ Cells(i, 基準列).Value ）には、所属部署名：「営業部」や「総務部」のような
＞ 文字列が入っているということですかね。　それならば、
＞ ファイル名 = Cells(i, 基準列).Value & "（○○名簿）"　　　　 のところを、拡張子を付けて
＞ ファイル名 = Cells(i, 基準列).Value & "（○○名簿）.xlsx"　　としたら、上手く動きませんか？
＞
＞ 個人的には ChDir はせず（カレントは変えず）に、[返信 2]に記載したように ↓フルパスで処理した方が
＞ 良いと思いますけど･･･
＞ ファイル名 = ThisWorkbook.Path & "\" & Cells(i, 基準列).Value & "（○○名簿）.xlsx"
＞