返回列表 上一主題 發帖

工作表另存新檔和以儲存格內容命名

回復 2# Andy2483

您好, 再想請教如何在你這CODE內, 將另存新檔的範圍 , 指定在A1 至E30 ?? 因為你的CODE很深, 在一般網頁都難找到作編輯:Q

謝謝!

TOP

本帖最後由 Andy2483 於 2023-12-13 16:21 編輯

回復 11# missbb


    謝謝前輩再回復,一起學習
後學藉此帖做複習心得與添加新需求,學習方案如下,請前輩參考
表格1:


Option Explicit
Sub TEST()
Application.ScreenUpdating = False
'↑令螢幕暫不隨程序變化結果
'Application.DisplayAlerts = False
'↑令程序不跳出 檔案要不要覆蓋 的詢問窗,直接覆蓋儲存

Dim A, Z, i&, T$, T1$, T2$, F1 As Range, F2 As Range
'↑宣告變數
Set Z = CreateObject("Scripting.Dictionary")
'↑令Z變數是 字典
T1 = "另存檔案路徑": T2 = "另存檔案名稱"
'↑令T1,T2變數是GJ; 雙引號之間的字串
For i = 1 To Worksheets.Count
'↑設順迴圈!令i從1到 此活頁簿工作表數量
   Set F1 = Sheets(i).[1:1].Find(T1, Lookat:=xlWhole)
   '↑令F1變數是 從第1列尋找 其內容與 "另存檔案路徑" 完全一樣的儲存格
   Set F2 = Sheets(i).[2:2].Find(T2, Lookat:=xlWhole)
   '↑令F2變數是 從第2列尋找 其內容與 "另存檔案名稱" 完全一樣的儲存格
   If F1 Is Nothing Or F2 Is Nothing Then GoTo i01 Else T = F2(1, 2) & "/S"
   '↑如果F1變數或 F2變數其中一個找不到!就跳到標示 i01的位置繼續執行,
   '否則就令T變數是F2變數同一列右邊格的內容連接 "/S"所組成的新字串

   If Z(T) <> "" Then MsgBox F2(1, 2) & " 檔名重複,請檢查": Exit Sub
   '↑如果以T變數查Z字典 回傳item值不是空的!代表檔案名稱重複了,跳出提示,結束程式執行
   Z(T) = F1(1, 2) & "": Set Z(F2(1, 2) & "") = Sheets(i): Z(F2(1, 2) & "/a") = F1.Address
   '↑令T變數為key,item是 F1變數同一列右邊格的字串內容,納入Z字典中
   '令F2變數同一列右邊格的字串內容為key,item是迴圈數所引號工作表
   '令F2變數同一列右邊格的內容連接 "/a"所組成的字串為key,item是 F1變數的儲存格位址

i01: Next
For Each A In Z.KEYS
'↑設逐項迴圈!令A變數是Z字典的key之一
   If Not IsObject(Z(A)) Then GoTo A01 Else T = Z(A & "/S")
   '↑如果以A變數查Z字典回傳item不是物件!就跳到標示 A01位置繼續執行,
   '否則就令T變數是 以A變數連接 "/S"所組成的字串查Z字典回傳值

   Z(A).Copy: If Dir(T, vbDirectory) = "" Then MkDir T
   '↑令A變數查Z字典回傳值(物件:工作表) 複製一份到新活頁簿
   '如果T變數的資料夾不存在!就建立T(字串)變數的資料夾

   With ActiveSheet.UsedRange: .Value = .Value: End With
   '↑令此新活頁簿裡的該新工作表都計算成值(公式變成值)
   Range(Z(A & "/a")).Resize(2, 2) = ""
   '↑令檔案路徑與檔案名稱4格變成空格
   
   '將另存新檔的範圍 , 指定在A1 至E30 ??
   '因為需求是要保留原來格式,所以以複製工作表到新活頁簿,再刪除不要的範圍即可
   ActiveSheet.UsedRange.Offset([A1:E30].Rows.Count, 0).EntireRow.Delete
   '↑令指定保留的範圍以下的列 刪除
   ActiveSheet.UsedRange.Offset(0, [A1:E30].Columns.Count).EntireColumn.Delete
   '↑令指定保留的範圍右側欄 刪除
   
   With ActiveWorkbook: .SaveAs Filename:=T & "\" & A: .Close: End With
   '↑令此新活頁簿儲存到指定路徑的檔名,之後關閉此新活頁簿
   ThisWorkbook.Activate
   '↑令程序回到本檔
A01: Next
End Sub
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

回復 12# Andy2483

非常感謝加入解釋, 無私指導:'(

TOP

回復 10# singo1232001
多謝指導!:D

TOP

        靜思自在 : 【做人的開始】每一天都是故人的開始,每一個時刻都是自己的警惕。
返回列表 上一主題