自動清除功能 - Excel程式區 - 麻辣家族討論版版

麻辣家族討論版版 » Excel程式區 » 自動清除功能

返回列表下一主題上一主題發帖

[發問] 自動清除功能

　暱稱: PJ

大學生 Rank: 4

帖子: 913
主題: 150
精華: 0
積分: 1089
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2023-7-19

論壇榮譽勳章論壇贊助勳章

4^# 跳轉到 »

發表於 2017-7-28 21:50 | 只看該作者

本帖最後由 GBKEE 於 2017-7-29 18:15 編輯

回復 2# GBKEE

大大,
請指導一下,我是要來源檔在未複製資料之前先排序,但總是有些問題
1) 來源檔與目的檔同時事先開啟,或同時不要開啟,它都無法執行
2) 先開啟目的檔,再執行巨集這時它會自行打開來源檔,這樣就可以完全執行也會先排序再貼上.
3) 我要怎麼修改讓它完全正常？

Option Explicit
Dim 目的檔 As Workbook, 來源檔 As Workbook
Sub 庫存更新()
Dim xRng As Range
File_settings 來源檔, "庫存資料表.xlsx"
File_settings 目的檔, "ERP_Data.xlsx"
Set xRng = 來源檔.Sheets(1).UsedRange 'UsedRange->工作表所使用的範圍,如A:AA之後再也沒資料
'來源檔第一個工作表,排序 1) L 2)F
With 來源檔.Sheets(1).Range("A:AA")
.Cells.Sort Key1:=.Columns("L"), Key2:=.Columns("F"), _
Header:=xlYes
xRng.Copy 'A:AA複製到目的檔B:AB
With 目的檔.Sheets("庫存")
.Range("B1").PasteSpecial xlPasteValues '選擇性貼上值
'自動清除目的檔1065:1073列
.Range("a" & xRng.Rows.Count + 1, .Range("A1101")).Resize(, 37).Clear
End With
End With
來源檔.Close False '來源檔關閉檔案(不會問是否存檔)
目的檔.Save
End Sub
Sub File_settings(xFile As Workbook, 工作頁 As String) '檔案設定
Dim xPath As String
xPath = ThisWorkbook.Path & "\"
If UCase(工作頁) <> UCase("ERP_Data.XLSX") Then xPath = xPath & "FromERP\"
On Error Resume Next
Set xFile = Workbooks(工作頁)
If Err > 0 Then Set xFile = Workbooks.Open(xPath & 工作頁)
If xFile.Name = "" Then
MsgBox "請查看 " & vbLf & xPath & vbLf & "是否有 [" & 工作頁 & "]"
End
End If
End Sub

複製代碼

　暱稱: PJ

大學生 Rank: 4

帖子: 913
主題: 150
精華: 0
積分: 1089
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2023-7-19

論壇榮譽勳章論壇贊助勳章

3^#

發表於 2017-7-27 21:48 | 只看該作者

[版主管理留言]

GBKEE(2017/7/28 10:49): 2# 已指名排序程式碼可寫在那裡

回復 2# GBKEE

大大,

因為我原來的程式有排序功能，這個新的程式沒把來源檔的排序功能寫進去,
1. 可以幫忙把它加上去嗎？
2. 更新程式後,要把來源檔關閉.

我本來想原來的排序功能直接添上去，但因為你的寫法不同,我加上去的話它就整個不能執行了。

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

2^#

發表於 2017-7-26 19:53 | 只看該作者

本帖最後由 GBKEE 於 2017-7-29 19:19 編輯

回復 1# PJChen

UCase的功能是什麼?
你學習的不夠認真,不懂要看看說明

試試看

Option Explicit
Dim 目的檔 As Workbook, 來源檔 As Workbook
Sub 庫存更新()
Dim xRng As Range
File_settings 來源檔, "庫存資料表.xlsx"
File_settings 目的檔, "ERP_Data.xlsx"
With 來源檔.Sheets(1)
.Cells.Sort Key1:=.Columns("L"), Key2:=.Columns("F"), Header:=xlYes
Set xRng = .UsedRange 'UsedRange->工作表所使用的範圍,如A:AA之後再也沒資料
xRng.Copy 'A:AA複製到目的檔B:AB
End With
With 目的檔.Sheets("庫存")
.Range("B1").PasteSpecial xlPasteValues '選擇性貼上值
'自動清除目的檔1065:1073列
.Range("a" & xRng.Rows.Count + 1, .Range("A1101")).Resize(, 27).Clear
End With
來源檔.Close False
目的檔.Save
End Sub
Sub File_settings(xFile As Workbook, 工作頁 As String) '檔案設定
Dim xPath As String
xPath = ThisWorkbook.Path & "\"
If UCase(工作頁) <> UCase("ERP_Data.XLSX") Then xPath = xPath & "FromERP\"
On Error Resume Next
Set xFile = Workbooks(工作頁)
If Err > 0 Then Set xFile = Workbooks.Open(xPath & 工作頁)
If xFile.Name = "" Then
MsgBox "請查看 " & vbLf & xPath & vbLf & "是否有 [" & 工作頁 & "]"
End
End If
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

靜思自在 : 忘功不忘過，忘怨不忘恩。

返回列表下一主題上一主題