□ 戻る □一般操作のサロン □ 使用方法 □ 新着記事 □ 新規に質問する！ □ トピック一覧 □ 検索 □ 過去ログ
[ 最新記事及び返信フォームをトピックトップへ ]
| 保存時間の短縮 | |
|---|---|
[194858] 保存時間の短縮- ■親トピック/記事引用/メール受信=OFF■ □投稿者/ はつもの -(2022/05/03(10:52)) □U R L/ Sheets(Array("Sheet1", "Sheet2")).Select
Sheets("Sheet2").Activate
Sheets(Array("Sheet1", "Sheet2")).Copy
ActiveSheet.Shapes.Range(Array("Rectangle 1")).Select
Selection.Delete
ActiveSheet.Shapes.Range(Array("Rectangle 2")).Select
Selection.Delete
ActiveSheet.Shapes.Range(Array("Rectangle 3")).Select
Selection.Delete
Dim Path As String, WSH As Variant
Set WSH = CreateObject("WScript.Shell")
Path = WSH.SpecialFolders("Desktop") & "\"
ActiveWorkbook.SaveAs Path & "集計" & Format(Date, "(yy.mm.dd)") & ".xlsx"
End Sub
元々Ｄｉｍ〜ＥｎｄＳｕｂ（デスクトップに保存）まで
組まれているファイルでしたが、少々見直し考えております。
Rectangle 1〜3を削除するコードをマクロの記録から作り
処理すると物凄く時間かかります。
デスクトップへ保存するにあたり、保存時間の短縮は可能でしょうか？
この記事にはVBAのコードが含まれています。 緑の太文字→注釈 茶色の太文字→条件分岐 赤の太文字→ループ 青の太文字→その他 ++++++++++++++++++++ OS ⇒OTHER Version⇒OTHER ++++++++++++++++++++ | |
[194859] Re[1]: 保存時間の短縮- ■記事引用/メール受信=OFF■ □投稿者/ topi -(2022/05/03(11:28)) □U R L/ シートの複製は時間がかかるものとして、他は ActiveSheet.Shapes("Rectangle 1").Delete こういうので良いんじゃないですかね。 | |
[194860] Re[2]: 保存時間の短縮- ■  / 記事引用/メール受信=OFF■
□投稿者/ はつもの -(2022/05/03(12:30)) □U R L/ '新しいBOOKへSheet1&Sheet2をｺﾋﾟﾍﾟ Worksheets(Array("Sheet1", "Sheet2")).Copy 'ActiveSheetｼｰﾄ内の図形を全選択⇒削除 ActiveSheet.Shapes.SelectAll Selection.ShapeRange.Delete topiさんのアドバイスも参考にし 上記で見直し、コードはすっきりしました。 ご支援ありがとうございました。 ++++++++++++++++++++ OS ⇒OTHER Version⇒OTHER ++++++++++++++++++++ | |